← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to Template/Source/rw_routines.f

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

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