← Back to branch summary

~maddevelopers/mg5amcnlo/WWW5_caching

« back to all changes in this revision

Viewing changes to users/mardelcourt/PROC_407857/PROC_407857/Source/MODEL/lha_read.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_407857/PROC_407857/Source/MODEL/lha_read.f
 
1
c************************************************************************
 
2
c**                                                                    **
 
3
c**           MadGraph/MadEvent Interface to FeynRules                 **
 
4
c**                                                                    **
 
5
c**          C. Duhr (Louvain U.) - M. Herquet (NIKHEF)                **
 
6
c**                                                                    **
 
7
c************************************************************************
 
8
 
 
9
c *************************************************************************
 
10
c **                                                                     **
 
11
c **                    LHA format reading routines                      **
 
12
c **                                                                     **
 
13
c *************************************************************************
 
14
 
 
15
 
 
16
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
17
c ++
 
18
c ++ LHA_islatin -> islatin=true if letter is a latin letter
 
19
c ++
 
20
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
21
 
 
22
      subroutine LHA_islatin(letter,islatin)
 
23
      implicit none
 
24
 
 
25
      logical islatin
 
26
      character letter
 
27
      integer i
 
28
 
 
29
      islatin=.false.
 
30
      i=ichar(letter)
 
31
      if(i.ge.65.and.i.le. 90) islatin=.true.
 
32
      if(i.ge.97.and.i.le.122) islatin=.true.
 
33
 
 
34
      end
 
35
 
 
36
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
37
c ++
 
38
c ++ LHA_isnum -> isnum=true if letter is a number
 
39
c ++
 
40
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
41
 
 
42
      subroutine LHA_isnum(letter,isnum)
 
43
      implicit none
 
44
 
 
45
      logical isnum
 
46
      character letter
 
47
      character*10 ref
 
48
      integer i
 
49
 
 
50
      isnum=.false.
 
51
      ref='1234567890'
 
52
 
 
53
      do i=1,10
 
54
        if(letter .eq. ref(i:i)) isnum=.true.
 
55
      end do
 
56
 
 
57
      end
 
58
 
 
59
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
60
c ++
 
61
c ++ LHA_firststring -> first is the first "word" of string
 
62
c ++ Warning: string is returned with first REMOVED!
 
63
c ++
 
64
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
65
 
 
66
      subroutine LHA_firststring(first,string)
 
67
 
 
68
      implicit none
 
69
      character*(*) string
 
70
      character*(*) first
 
71
      
 
72
      if(len_trim(string).le.0) return
 
73
      
 
74
      do while(string(1:1) .eq. ' ') 
 
75
        string=string(2:len(string))
 
76
      end do
 
77
      if (index(string,' ').gt.1) then
 
78
         first=string(1:index(string,' ')-1)
 
79
         string=string(index(string,' '):len(string))
 
80
      else 
 
81
         first=string
 
82
      end if
 
83
 
 
84
      end
 
85
 
 
86
 
 
87
      subroutine LHA_case_trap(name)
 
88
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
89
c ++
 
90
c ++ LHA_case_trap -> change string to lower case
 
91
c ++
 
92
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
93
      implicit none
 
94
      
 
95
      character*20 name
 
96
      integer i,k
 
97
 
 
98
      do i=1,20
 
99
         k=ichar(name(i:i))
 
100
         if(k.ge.65.and.k.le.90) then  !upper case A-Z
 
101
            k=ichar(name(i:i))+32
 
102
            name(i:i)=char(k)
 
103
         endif
 
104
      enddo
 
105
 
 
106
      return
 
107
      end
 
108
 
 
109
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
110
c ++
 
111
c ++ LHA_blockread -> read a LHA line and return parameter name (evntually found in 
 
112
c ++ a ref file) and value
 
113
c ++
 
114
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
115
 
 
116
      subroutine LHA_blockread(blockname,buff,par,val,found)
 
117
 
 
118
      implicit none
 
119
      character*132 buff,buffer,curr_ref,curr_buff
 
120
      character*20 blockname,val,par,temp,first_ref,first_line
 
121
      logical fopened
 
122
      integer ref_file
 
123
      logical islast,isnum,found
 
124
      character*20 temp_val
 
125
 
 
126
 
 
127
c     *********************************************************************
 
128
c     Try to find a correspondance in ident_card
 
129
c
 
130
      ref_file = 20
 
131
      call LHA_open_file(ref_file,'ident_card.dat',fopened)
 
132
      if(.not. fopened) goto 99 ! If the file does not exist -> no matter, use default!
 
133
        
 
134
      islast=.false.
 
135
      found=.false.
 
136
      do while(.not. found)!run over reference file
 
137
      
 
138
 
 
139
        ! read a line
 
140
        read(ref_file,'(a132)',end=98,err=98) buffer
 
141
        
 
142
        ! Seek a corresponding blockname
 
143
        call LHA_firststring(temp,buffer)
 
144
        call LHA_case_trap(temp)
 
145
        
 
146
        if(temp .eq. blockname) then
 
147
             ! Seek for a corresponding LHA code
 
148
             curr_ref=buffer
 
149
             curr_buff=buff
 
150
             first_ref=''
 
151
             first_line=''
 
152
             
 
153
             do while((.not. islast).and.(first_ref .eq. first_line))
 
154
                 call LHA_firststring(first_ref,curr_ref)
 
155
                 call LHA_firststring(first_line,curr_buff)
 
156
                 call LHA_islatin(first_ref(1:1),islast)
 
157
                 if (islast) then
 
158
                   par=first_ref
 
159
                   val=first_line ! If found set param name & value
 
160
                   found=.true.
 
161
                 end if
 
162
             end do
 
163
        end if
 
164
                     
 
165
      end do
 
166
98    close(ref_file)
 
167
99    return    
 
168
      end
 
169
 
 
170
 
 
171
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
172
c ++
 
173
c ++ LHA_loadcard -> Open a LHA file and load all model param in a table
 
174
c ++
 
175
c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
176
 
 
177
      subroutine LHA_loadcard(param_name,npara,param,value)
 
178
 
 
179
      implicit none
 
180
 
 
181
      integer maxpara
 
182
      parameter (maxpara=1000)
 
183
      character*20 param(maxpara),value(maxpara),val,par
 
184
      character*20 blockname
 
185
      integer npara
 
186
      logical fopened,found
 
187
      integer iunit,GL,logfile
 
188
      character*20 ctemp
 
189
      character*132 buff
 
190
      character*20 tag
 
191
      character*132 temp
 
192
      character*(*) param_name
 
193
      data iunit/21/
 
194
      data logfile/22/
 
195
      GL=0
 
196
      npara=1
 
197
 
 
198
      param(1)=' '
 
199
      value(1)=' '
 
200
 
 
201
      ! Try to open param-card file
 
202
      call LHA_open_file(iunit,param_name,fopened)
 
203
      if(.not.fopened) then
 
204
         write(*,*) 'Error: Could not open file',param_name
 
205
         write(*,*) 'Exiting'
 
206
         stop
 
207
      endif
 
208
      
 
209
      ! Try to open log file
 
210
      open (unit = logfile, file = "param.log")
 
211
      
 
212
      ! Scan the data file
 
213
      do while(.true.)  
 
214
      
 
215
         read(iunit,'(a132)',end=99,err=99) buff
 
216
         
 
217
         if(buff .ne. '' .and. buff(1:1) .ne.'#') then ! Skip comments and empty lines
 
218
 
 
219
             tag=buff(1:5)
 
220
             call LHA_case_trap(tag) ! Select decay/block tag
 
221
             if(tag .eq. 'block') then ! If we are in a block, get the blockname
 
222
                 temp=buff(7:132)
 
223
                 call LHA_firststring(blockname,temp)
 
224
                 call LHA_case_trap(blockname)
 
225
             else if (tag .eq. 'decay') then ! If we are in a decay, directly try to get back the correct name/value pair
 
226
                 blockname='decay'
 
227
                 temp=buff(7:132)
 
228
                 call LHA_blockread(blockname,temp,par,val,found)
 
229
                 if(found) GL=1
 
230
             else if ((tag .eq. 'qnumbers').or.(blockname.eq.'')) then! if qnumbers or empty tag do nothing
 
231
                 blockname=''
 
232
             else ! If we are in valid block, try to get back a name/value pair
 
233
                 call LHA_blockread(blockname,buff,par,val,found)
 
234
                 if(found) GL=1
 
235
             end if
 
236
 
 
237
             !if LHA_blockread has been called, record name and value
 
238
 
 
239
             if(GL .eq. 1) then
 
240
                  value(npara)=val
 
241
                  ctemp=par
 
242
                  call LHA_case_trap(ctemp)
 
243
                  param(npara)=ctemp
 
244
                  npara=npara+1
 
245
                  GL=0
 
246
                  write (logfile,*) 'Parameter ',ctemp,
 
247
     &                                  ' has been read with value ',val
 
248
             endif
 
249
 
 
250
         endif
 
251
      enddo
 
252
      
 
253
      npara=npara-1
 
254
c      close(iunit)
 
255
      close(logfile)
 
256
      
 
257
 99   return
 
258
 
 
259
      end
 
260
 
 
261
 
 
262
 
 
263
      subroutine LHA_get_real(npara,param,value,name,var,def_value_num)
 
264
c----------------------------------------------------------------------------------
 
265
c     finds the parameter named "name" in param and associate to "value" in value
 
266
c----------------------------------------------------------------------------------
 
267
      implicit none
 
268
 
 
269
c
 
270
c     parameters
 
271
c
 
272
      integer maxpara
 
273
      parameter (maxpara=1000)
 
274
c
 
275
c     arguments
 
276
c
 
277
      integer npara
 
278
      character*20 param(maxpara),value(maxpara)
 
279
      character*(*)  name
 
280
      real*8 var,def_value_num
 
281
      character*20 c_param,c_name,ctemp
 
282
      character*19 def_value
 
283
c
 
284
c     local
 
285
c
 
286
      logical found
 
287
      integer i
 
288
c
 
289
c     start
 
290
c
 
291
      i=1
 
292
      found=.false.
 
293
      do while(.not.found.and.i.le.npara)
 
294
         ctemp=param(i)
 
295
         call LHA_firststring(c_param,ctemp)
 
296
         ctemp=name
 
297
         call LHA_firststring(c_name,ctemp)
 
298
         call LHA_case_trap(c_name)
 
299
         call LHA_case_trap(c_param)
 
300
         found = (c_param .eq. c_name)
 
301
         if (found) then
 
302
             read(value(i),*) var
 
303
         end if
 
304
         i=i+1
 
305
      enddo
 
306
      if (.not.found) then
 
307
         write (*,*) "Warning: parameter ",name," not found"
 
308
         write (*,*) "         setting it to default value ",
 
309
     &def_value_num
 
310
         var=def_value_num
 
311
      endif
 
312
      return
 
313
 
 
314
      end
 
315
c
 
316
 
 
317
      subroutine LHA_open_file(lun,filename,fopened)
 
318
c***********************************************************************
 
319
c ����opens file input-card.dat in current directory or above
 
320
c***********************************************************************
 
321
      implicit none
 
322
c
 
323
c ����Arguments
 
324
c
 
325
      integer lun
 
326
      logical fopened
 
327
      character*(*) filename
 
328
      character*90  tempname
 
329
      integer fine
 
330
      integer dirup,i
 
331
 
 
332
c-----
 
333
c �Begin Code
 
334
c-----
 
335
c
 
336
c ����first check that we will end in the main directory
 
337
c
 
338
      open(unit=lun,file=filename,status='old',ERR=20)
 
339
c      write(*,*) 'read model file ',filename
 
340
      fopened=.true.
 
341
      return
 
342
      
 
343
20    tempname=filename
 
344
      fine=index(tempname,' ')
 
345
      if(fine.eq.0) fine=len(tempname)
 
346
      tempname=tempname(1:fine)
 
347
c
 
348
c ��������if I have to read a card
 
349
c
 
350
      if(index(filename,"_card").gt.0) then
 
351
        tempname='./Cards/'//tempname
 
352
      endif
 
353
 
 
354
      fopened=.false.
 
355
      do i=0,5
 
356
        open(unit=lun,file=tempname,status='old',ERR=30)
 
357
        fopened=.true.
 
358
c        write(*,*) 'read model file ',tempname
 
359
        exit
 
360
30      tempname='../'//tempname
 
361
        if (i.eq.5)then
 
362
           write(*,*) 'Warning: file ',filename,
 
363
     &                           ' not found in the parent directories!'
 
364
           stop
 
365
        endif
 
366
      enddo
 
367
 
 
368
      return
 
369
      end
 
370