EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lmidat.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lmidat.F
1 
2 C **********************************************************************
3 
4  SUBROUTINE lmidat
5 
6  IMPLICIT NONE
7 
8 C...This is the MINUIT routine MIDATA.
9 CC GETS PARAMETERS FROM /LMINUI/ AND /LMINUC/
10 CC AND SETS UP THE STARTING PARAMETER LISTS.
11 CC CONTROL THEN PASSES TO LMCMND FOR READING THE COMMAND "CARDS".
12 CC
13 
14  COMMON
15  1/lmmine/ erp(30) ,ern(30)
16  2/lmpari/ x(15) ,xt(15) ,dirin(15) ,maxint ,npar
17  3/lmpare/ u(30) ,werr(30) ,maxext ,nu
18  4/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
19  5/lmvari/ v(15,15)
20  7/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
21  7/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
22  c/lmcasc/ y(16) ,jh ,jl
23  f/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
24  g/lmsimv/ p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
25  j/lmvart/ vt(15,15)
26  COMMON
27  6/lmunit/ isysrd ,isyswr ,isyspu
28  8/lmtitl/ title(13),date(2) ,isw(7) ,nblock
29  9/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
30  a/lmcard/ cword ,cword2 ,cword3 ,word7(7)
31  b/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
32 
33  REAL erp,ern
34  INTEGER maxint,npar
35  REAL x,xt,dirin
36  INTEGER maxext ,nu
37  REAL u,werr
38  INTEGER lcode,lcorsp,limset
39  REAL alim,blim
40  REAL v
41  INTEGER ipfix,npfix
42  REAL xs,xts,dirins
43  REAL grds,g2s,gsteps,aberfs
44  REAL y
45  INTEGER jh,jl
46  REAL gin,grd,g2,gstep,aberf
47  REAL p,pstar,pstst,pbar,prho
48  REAL vt
49 ***** COMMON
50  INTEGER isysrd ,isyswr ,isyspu
51  REAL title,date
52  INTEGER isw,nblock
53  REAL epsi ,apsi ,vtest
54  INTEGER nstepq ,nfcn ,nfcnmx
55  REAL cword ,cword2 ,cword3 ,word7
56  REAL amin ,up ,sigma,epsmac
57  INTEGER newmin ,itaur
58 
59  COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),bin(4),
60  &maxfin,relup,relerr,reler2,fcnmax
61  REAL xkin,ukin,wkin,ain,bin,relerr,relup,reler2,fcnmax
62  INTEGER maxfin
63  SAVE /lminui/
64 
65  COMMON /lminuc/ namkin(4),nam(30)
66  CHARACTER*10 namkin,nam
67  SAVE /lminuc/
68 
69  COMMON /lpflag/ lst3
70  INTEGER lst3
71  SAVE /lpflag/
72 
73 
74 
75  REAL xk,uk,wk,a,b,versn,time,sav,sav2,vplu,vminu
76  INTEGER mninit,ifatal,nint,i,iunit,k
77  CHARACTER*10 namk,blank
78  CHARACTER xtitle*60
79  REAL lmpint
80  DATA blank/' '/
81  DATA xtitle/' FIND MINIMUM OF -(DIFFERENTIAL CROSS SECTION)'/
82  DATA mninit/0/,ifatal,nint/0,0/
83 C . INITIALIZE NEW DATA BLOCK . .
84  IF (mninit .EQ. 0) nblock=0
85  mninit = 1
86  nblock = nblock + 1
87  versn = 11.79
88  IF(lst3.GE.5) THEN
89  WRITE (isyswr,1004) maxint,maxext,versn,nblock
90  WRITE (isyswr,1005)
91  ENDIF
92  DO 50 i= 1, 7
93  50 isw(i) = 0
94  sigma = 0.
95  CALL ltimex(time)
96  IF(lst3.GE.5) THEN
97  WRITE (isyswr,1110) xtitle,time,epsmac
98  WRITE (isyswr,1005)
99  ENDIF
100  npfix = 0
101  nint = 0
102  nu = 0
103  npar = 0
104  ifatal = 0
105  IF(lst3.GE.5) WRITE (isyswr,1005)
106  DO 100 i= 1, maxext
107  u(i) = 0.0
108  nam(i) = blank
109  erp(i) = 0.0
110  ern(i) = 0.0
111  lcode(i) = 0
112  100 lcorsp(i) = 0
113  up = 1.0
114  isw(5) = 1
115  iunit = isysrd
116 C . . . READ PARAMETER CARDS . .
117  entry lmida2
118  DO 200 i= 1, 200
119  IF(i.GE.5) goto 250
120  xk=xkin(i)
121  namk=namkin(i)
122  uk=ukin(i)
123  wk=wkin(i)
124  a=ain(i)
125  b=bin(i)
126  k = xk + 0.1
127  nu = max0(nu,k)
128  IF (k .LE. 0) go to 250
129  IF (k .LE. maxext) go to 115
130  ifatal = ifatal + 1
131  IF(lst3.GE.1) THEN
132  WRITE (isyswr,1009) k,maxext
133  WRITE (isyswr,1002) k,namk,uk,wk,a,b
134  ENDIF
135  go to 200
136  115 CONTINUE
137  IF(nam(k).EQ.blank) go to 120
138 C PREVIOUSLY DEFINED PARAMETER IS BEING REDEFINED
139  IF(lst3.GE.1) WRITE(isyswr,1007)
140  IF(werr(k).GT..0) nint=nint-1
141  120 CONTINUE
142  nam(k) = namk
143  u(k) = uk
144  werr(k) = wk
145  IF (wk .GT. 0.0) go to 122
146 C . . . FIXED PARAMETER . . . .
147  IF(lst3.GE.5) WRITE (isyswr, 1002) k,namk,uk
148  lcode(k) = 0
149  go to 160
150 C . . . VARIABLE PARAMETER . . .
151  122 IF(lst3.GE.5) WRITE (isyswr, 1002) k,namk,uk,wk,a,b
152  nint = nint + 1
153  isw(2) = 0
154  IF (a) 140,130,140
155  130 IF (b) 140,135,140
156  135 lcode(k) = 1
157  go to 160
158  140 IF (b-a) 145,142,150
159  142 ifatal = ifatal + 1
160  IF(lst3.GE.1) WRITE (isyswr,1010)
161  go to 150
162  145 sav = b
163  b = a
164  a = sav
165  IF(lst3.GE.1) WRITE (isyswr,1003)
166  150 alim(k) = a
167  blim(k) = b
168  lcode(k) = 4
169  IF ((b-u(k))*(u(k)-a)) 153,155,160
170  153 ifatal = ifatal + 1
171  IF(lst3.GE.1) WRITE (isyswr,1011)
172  go to 160
173  155 IF(lst3.GE.1) WRITE (isyswr,1006)
174  160 CONTINUE
175  200 CONTINUE
176  ifatal = ifatal + 1
177  IF(lst3.GE.1) WRITE (isyswr,1012)
178 C . . . END PARAMETER CARDS
179 C . . . STOP IF FATAL ERROR
180  250 IF(lst3.GE.5) WRITE (isyswr,1005)
181  IF (nint .LE. maxint) go to 253
182  IF(lst3.GE.1) WRITE (isyswr,1008) nint,maxint
183  ifatal = ifatal + 1
184  253 IF (ifatal .LE. 0) go to 280
185  IF(lst3.GE.1) WRITE (isyswr,1013) ifatal
186  IF(lst3.GE.2) stop
187 C CALCULATE STEP SIZES DIRIN
188  280 npar = 0
189  DO 300 k= 1, nu
190  IF (lcode(k) .LE. 0) go to 300
191  npar = npar + 1
192  lcorsp(k) = npar
193  sav = u(k)
194  x(npar) = lmpint(sav,k)
195  xt(npar) = x(npar)
196  sav2 = sav + werr(k)
197  vplu = lmpint(sav2,k) - x(npar)
198  sav2 = sav - werr(k)
199  vminu = lmpint(sav2,k) - x(npar)
200  dirin(npar) = 0.5 * (abs(vplu) +abs(vminu))
201  g2(npar) = 2.0 / dirin(npar)**2
202  gstep(npar) = dirin(npar)
203  IF (lcode(k) .GT. 1) gstep(npar) = -gstep(npar)
204  300 CONTINUE
205  sigma = 1.0e10
206  iunit = isysrd
207  RETURN
208 C... THE FORMAT BELOW IS MACHINE-DEPENDENT. (A10) , (A6,4X) , ETC.
209  1002 FORMAT (i10,2x,a10,2x,2g12.6,2x,2g12.6)
210  1003 FORMAT(' WARNING - ABOVE LIMITS HAVE BEEN REVERSED.')
211  1004 FORMAT (1h1/42x,21(1h*)/42x,21h* d506 minuit */42x,
212  112h* dimensions, i3, 1h/, i3, 2h */ 42x,
213  1'* MODIFICATION OF *',/,42x,
214  111h* version ,f6.2,4h */42x,16h* DATA block no. ,i3,2h *)
215  1005 FORMAT (4x,96(1h*))
216  1006 FORMAT(' WARNING - ABOVE PARAMETER IS AT LIMIT ')
217  1007 FORMAT(' WARNING ******* - PARAMETER REQUESTED ON FOLLOWING',
218  1' CARD HAS ALREADY APPEARED. PREVIOUS VALUES IGNORED.')
219  1008 FORMAT('0 TOO MANY VARIABLE PARAMETERS. YOU REQUEST',i5/,
220  +' THIS VERSION OF MINUIT IS ONLY DIMENSIONED FOR',i4//)
221  1009 FORMAT('0FATAL ERROR. PARAMETER NUMBER',i11,' GREATER THAN ',
222  +'ALLOWED MAXIMUM',i4)
223  1010 FORMAT(' FATAL ERROR. UPPER AND LOWER LIMITS ARE EQUAL.')
224  1011 FORMAT(' FATAL ERROR. PARAMETER OUTSIDE LIMITS',/)
225  1012 FORMAT('0FATAL ERROR. MORE THAN 200 PARAMETER CARDS',/)
226  1013 FORMAT(/i5,' FATAL ERRORS ON PARAMETER CARDS. ABORT.',//)
227  1110 FORMAT(5x,a60,5x,'TIME',f8.3,' SECONDS',/,70x,'MACH. PREC.=',
228  &e10.2)
229  END