← Back to branch summary

~maddevelopers/mg5amcnlo/WWW5_caching

« back to all changes in this revision

Viewing changes to users/mardelcourt/PROC_242195/PROC_242195/Source/rw_routines.f

  • Committer: John Doe
  • Date: 2013-03-25 20:27:02 UTC
  • Revision ID: john.doe@gmail.com-20130325202702-5sk3t1r8h33ca4p4
first clean version

Show diffs side-by-side

added added

removed removed

Lines of Context:
users/mardelcourt/PROC_242195/PROC_242195/Source/rw_routines.f
 
1
      subroutine load_para(npara,param,value)
 
2
c----------------------------------------------------------------------
 
3
c Read the params from the run_card.dat file
 
4
c---------------------------------------------------------------------- 
 
5
      implicit none
 
6
c
 
7
c     arguments
 
8
c     
 
9
      character*20 param(*),value(*)
 
10
      integer npara
 
11
c
 
12
c     local
 
13
c
 
14
      logical fopened,done
 
15
      integer iunit
 
16
      character*20 ctemp
 
17
      integer k,i,l1,l2,iproc
 
18
      character*132 buff
 
19
      data iunit/21/
 
20
c
 
21
c     global
 
22
c
 
23
      integer ngroup
 
24
      common/to_group/ngroup
 
25
c
 
26
c----------
 
27
c     start
 
28
c----------
 
29
c
 
30
c     read the run_card.dat
 
31
c
 
32
      npara=0
 
33
      param(1)=' '
 
34
      value(1)=' '
 
35
c
 
36
c     open file
 
37
c
 
38
      call open_file(iunit,'run_card.dat',fopened)
 
39
      if(.not.fopened) then
 
40
         write(*,*) 'Error: File run_card.dat not found'
 
41
         stop
 
42
      else
 
43
c
 
44
c     first look for process-specific parameters
 
45
c
 
46
      done=.false.
 
47
      do while(.not.done)  
 
48
         read(iunit,'(a132)',end=20,err=20) buff
 
49
         if(buff(1:1).ne.'#' .and. index(buff,"=").gt.0
 
50
     $        .and. index(buff,"@").gt.0) then
 
51
            l1=index(buff,"@")
 
52
            l2=index(buff,"!")
 
53
            if(l2.eq.0) l2=l1+20  !maybe there is no comment...
 
54
            read(buff(l1+1:l2),*,err=11) iproc
 
55
            if(iproc.ne.ngroup) cycle
 
56
 
 
57
            l1=index(buff,"=")
 
58
            l2=index(buff,"@")
 
59
            if(l2-l1.lt.0) cycle
 
60
            npara=npara+1
 
61
c
 
62
             value(npara)=buff(1:l1-1)
 
63
             ctemp=value(npara)
 
64
             call case_trap2(ctemp)
 
65
             value(npara)=ctemp
 
66
c
 
67
             param(npara)=" "//buff(l1+1:l2-1)
 
68
             ctemp=param(npara)
 
69
             call case_trap2(ctemp)
 
70
             param(npara)=ctemp
 
71
c
 
72
 11          cycle
 
73
         endif
 
74
      enddo
 
75
 20   rewind(iunit)
 
76
c
 
77
c     read in values
 
78
c
 
79
      done=.false.
 
80
      do while(.not.done)  
 
81
         read(iunit,'(a132)',end=96,err=96) buff
 
82
         if(buff(1:1).ne.'#' .and. index(buff,"=").gt.0
 
83
     $        .and. index(buff,"@").le.0) then
 
84
            l1=index(buff,"=")
 
85
            l2=index(buff,"!")
 
86
            if(l2.eq.0) l2=l1+20  !maybe there is no comment...
 
87
            if(l2-l1.lt.0) cycle
 
88
            npara=npara+1
 
89
c
 
90
             value(npara)=buff(1:l1-1)
 
91
             ctemp=value(npara)
 
92
             call case_trap2(ctemp)
 
93
             value(npara)=ctemp
 
94
c
 
95
             param(npara)=" "//buff(l1+1:l2-1)
 
96
             ctemp=param(npara)
 
97
             call case_trap2(ctemp)
 
98
             param(npara)=ctemp
 
99
c
 
100
         endif
 
101
      enddo
 
102
 96   close(iunit)
 
103
      endif
 
104
c
 
105
c     open file
 
106
c
 
107
c
 
108
c     tjs modified 11-16-07 to include grid_card.dat
 
109
c
 
110
      call open_file(iunit,'grid_card.dat',fopened)
 
111
      if(fopened) then
 
112
c
 
113
c     first look for process-specific parameters
 
114
c
 
115
      done=.false.
 
116
      do while(.not.done)  
 
117
         read(iunit,'(a132)',end=30,err=30) buff
 
118
         if(buff(1:1).ne.'#' .and. index(buff,"=").gt.0
 
119
     $        .and. index(buff,"@").gt.0) then
 
120
            l1=index(buff,"@")
 
121
            l2=index(buff,"!")
 
122
            if(l2.eq.0) l2=l1+20  !maybe there is no comment...
 
123
            read(buff(l1+1:l2),*,err=21) iproc
 
124
            if(iproc.ne.ngroup) cycle
 
125
 
 
126
            l1=index(buff,"=")
 
127
            l2=index(buff,"@")
 
128
            if(l2-l1.lt.0) cycle
 
129
            npara=npara+1
 
130
c
 
131
             value(npara)=buff(1:l1-1)
 
132
             ctemp=value(npara)
 
133
             call case_trap2(ctemp)
 
134
             value(npara)=ctemp
 
135
c
 
136
             param(npara)=" "//buff(l1+1:l2-1)
 
137
             ctemp=param(npara)
 
138
             call case_trap2(ctemp)
 
139
             param(npara)=ctemp
 
140
c
 
141
 21          cycle
 
142
         endif
 
143
       enddo
 
144
 30   rewind(iunit)
 
145
c
 
146
c     read in values
 
147
c
 
148
      done=.false.
 
149
      do while(.not.done)  
 
150
         read(iunit,'(a132)',end=99,err=99) buff
 
151
         if(buff(1:1).ne.'#' .and. index(buff,"=").gt.0
 
152
     $        .and. index(buff,"@").le.0) then
 
153
            l1=index(buff,"=")
 
154
            l2=index(buff,"!")
 
155
            if(l2.eq.0) l2=l1+20  !maybe there is no comment...
 
156
            if(l2-l1.lt.0) cycle
 
157
            npara=npara+1
 
158
c
 
159
             value(npara)=buff(1:l1-1)
 
160
             ctemp=value(npara)
 
161
             call case_trap2(ctemp)
 
162
             value(npara)=ctemp
 
163
c
 
164
             param(npara)=" "//buff(l1+1:l2-1)
 
165
c             write (*,*) param(npara),l1,l2
 
166
             ctemp=param(npara)
 
167
             call case_trap2(ctemp)
 
168
             param(npara)=ctemp
 
169
c             write(*,*) "New param:",param(npara)," = ", value(npara)
 
170
c
 
171
         endif
 
172
      enddo
 
173
 99   close(iunit)
 
174
      endif
 
175
 
 
176
      return
 
177
      end
 
178
 
 
179
 
 
180
 
 
181
      subroutine get_real(npara,param,value,name,var,def_value)
 
182
c----------------------------------------------------------------------------------
 
183
c     finds the parameter named "name" in param and associate to "value" in value 
 
184
c----------------------------------------------------------------------------------
 
185
      implicit none
 
186
 
 
187
c
 
188
c     arguments
 
189
c
 
190
      integer npara
 
191
      character*20 param(*),value(*)
 
192
      character*(*)  name
 
193
      real*8 var,def_value
 
194
      character*20 c_param,c_name
 
195
c
 
196
c     local
 
197
c
 
198
      logical found
 
199
      integer i
 
200
c
 
201
c     start
 
202
c
 
203
      i=1
 
204
      found=.false.
 
205
      do while(.not.found.and.i.le.npara)
 
206
          call firststring(c_param,param(i))
 
207
          call firststring(c_name,name)
 
208
         found = (c_param .eq. c_name)
 
209
         if (found) read(value(i),*) var
 
210
c         if (found) write (*,*) name,var
 
211
         i=i+1
 
212
      enddo
 
213
      if (.not.found) then
 
214
         write (*,*) "Warning: parameter ",name," not found"
 
215
         write (*,*) "         setting it to default value ",def_value
 
216
         var=def_value
 
217
      endif
 
218
      return
 
219
 
 
220
      end
 
221
c
 
222
 
 
223
      subroutine get_integer(npara,param,value,name,var,def_value)
 
224
c----------------------------------------------------------------------------------
 
225
c     finds the parameter named "name" in param and associate to "value" in value 
 
226
c----------------------------------------------------------------------------------
 
227
      implicit none
 
228
c
 
229
c     arguments
 
230
c
 
231
      integer npara
 
232
      character*20 param(*),value(*)
 
233
      character*(*)  name
 
234
      integer var,def_value
 
235
      character*20 c_param,c_name
 
236
c
 
237
c     local
 
238
c
 
239
      logical found
 
240
      integer i
 
241
c
 
242
c     start
 
243
c
 
244
      i=1
 
245
      found=.false.
 
246
      do while(.not.found.and.i.le.npara)
 
247
         call firststring(c_param,param(i))
 
248
          call firststring(c_name,name)
 
249
         found = (c_param .eq. c_name)
 
250
         if (found) read(value(i),*) var
 
251
c         if (found) write (*,*) name,var
 
252
         i=i+1
 
253
      enddo
 
254
      if (.not.found) then
 
255
         write (*,*) "Warning: parameter ",name," not found"
 
256
         write (*,*) "         setting it to default value ",def_value
 
257
         var=def_value
 
258
      endif
 
259
      return
 
260
 
 
261
      end
 
262
c
 
263
      subroutine get_int8(npara,param,value,name,var,def_value)
 
264
c----------------------------------------------------------------------------------
 
265
c     finds the parameter named "name" in param and associate to "value" in value 
 
266
c----------------------------------------------------------------------------------
 
267
      implicit none
 
268
c
 
269
c     arguments
 
270
c
 
271
      integer npara
 
272
      character*20 param(*),value(*)
 
273
      character*(*)  name
 
274
      integer def_value
 
275
      integer*8 var
 
276
      character*20 c_param,c_name
 
277
c
 
278
c     local
 
279
c
 
280
      logical found
 
281
      integer i
 
282
c
 
283
c     start
 
284
c
 
285
      i=1
 
286
      found=.false.
 
287
      do while(.not.found.and.i.le.npara)
 
288
         call firststring(c_param,param(i))
 
289
          call firststring(c_name,name)
 
290
         found = (c_param .eq. c_name)
 
291
         if (found) read(value(i),*) var
 
292
c         if (found) write (*,*) name,var
 
293
         i=i+1
 
294
      enddo
 
295
      if (.not.found) then
 
296
         write (*,*) "Warning: parameter ",name," not found"
 
297
         write (*,*) "         setting it to default value ",def_value
 
298
         var=def_value
 
299
      endif
 
300
      return
 
301
 
 
302
      end
 
303
c
 
304
      subroutine get_string(npara,param,value,name,var,def_value)
 
305
c----------------------------------------------------------------------------------
 
306
c     finds the parameter named "name" in param and associate to "value" in value 
 
307
c----------------------------------------------------------------------------------
 
308
      implicit none
 
309
 
 
310
c
 
311
c     arguments
 
312
c
 
313
      integer npara
 
314
      character*20 param(*),value(*)
 
315
      character*(*)  name
 
316
      character*(*)  var,def_value
 
317
      character*20 c_param,c_name
 
318
c
 
319
c     local
 
320
c
 
321
      logical found
 
322
      integer i
 
323
c
 
324
c     start
 
325
c
 
326
      i=1
 
327
      found=.false.
 
328
      do while(.not.found.and.i.le.npara)
 
329
         call firststring(c_param,param(i))
 
330
          call firststring(c_name,name)
 
331
         found = (c_param .eq. c_name)
 
332
         if (found) read(value(i),*) var
 
333
c         if (found) write (*,*) name,var
 
334
         i=i+1
 
335
      enddo
 
336
      if (.not.found) then
 
337
         write (*,*) "Warning: parameter ",name," not found"
 
338
         write (*,*) "         setting it to default value ",def_value
 
339
         var=def_value
 
340
      endif
 
341
      return
 
342
 
 
343
      end
 
344
c
 
345
      subroutine get_logical(npara,param,value,name,var,def_value)
 
346
c----------------------------------------------------------------------------------
 
347
c     finds the parameter named "name" in param and associate to "value" in value 
 
348
c----------------------------------------------------------------------------------
 
349
      implicit none
 
350
 
 
351
c
 
352
c     arguments
 
353
c
 
354
      integer npara
 
355
      character*20 param(*),value(*)
 
356
      character*(*)  name
 
357
      logical  var,def_value
 
358
      character*20 c_param,c_name
 
359
c
 
360
c     local
 
361
c
 
362
      logical found
 
363
      integer i
 
364
c
 
365
c     start
 
366
c
 
367
      i=1
 
368
      found=.false.
 
369
      do while(.not.found.and.i.le.npara)
 
370
         call firststring(c_param,param(i))
 
371
          call firststring(c_name,name)
 
372
         found = (c_param .eq. c_name)
 
373
         if (found) read(value(i),*) var
 
374
c         if (found) write (*,*) name,var
 
375
         i=i+1
 
376
      enddo
 
377
      if (.not.found) then
 
378
         write (*,*) "Warning: parameter ",name," not found"
 
379
         write (*,*) "         setting it to default value ",def_value
 
380
         var=def_value
 
381
      endif
 
382
      return
 
383
 
 
384
      end
 
385
c
 
386
 
 
387
 
 
388
 
 
389
      subroutine case_trap2(name)
 
390
c**********************************************************    
 
391
c change the string to lowercase if the input is not
 
392
c**********************************************************
 
393
      implicit none
 
394
c
 
395
c     ARGUMENT
 
396
c      
 
397
      character*20 name
 
398
c
 
399
c     LOCAL
 
400
c
 
401
      integer i,k
 
402
 
 
403
      do i=1,20
 
404
         k=ichar(name(i:i))
 
405
         if(k.ge.65.and.k.le.90) then  !upper case A-Z
 
406
            k=ichar(name(i:i))+32   
 
407
            name(i:i)=char(k)        
 
408
         endif
 
409
      enddo
 
410
 
 
411
      return
 
412
      end
 
413
 
 
414
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
415
c ++
 
416
c ++ firststring -> return the first "word" of string 
 
417
c ++ & remove whitespaces around
 
418
c ++ Needed to correct a bug in "get_" routines
 
419
c ++ Michel Herquet - CP3 - 05-04-2006
 
420
c ++
 
421
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
422
 
 
423
      subroutine firststring(first,string)
 
424
 
 
425
      implicit none
 
426
      character*(*) string
 
427
      character*20 first
 
428
      character*20 temp
 
429
 
 
430
      temp=string
 
431
      do while(temp(1:1) .eq. ' ') 
 
432
        temp=temp(2:len(temp))
 
433
      end do
 
434
      first=temp(1:index(temp,' ')-1)
 
435
 
 
436
      end