EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lmcmnd.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lmcmnd.F
1 
2 C#######################################################################
3 C
4 C The following routines are slightly modified minimization routines
5 C from the MINUIT program package.
6 C
7 C **********************************************************************
8 
9  SUBROUTINE lmcmnd
10 
11  IMPLICIT NONE
12 
13 C...This is the MINUIT routine COMAND.
14 CC GETS IFORMATION FROM /LMINUI/ AND TAKES APPROPRIATE ACTION,
15 CC EITHER DIRECTLY BY SKIPPING TO THE CORRESPONDING CODE IN
16 CC LMCMND, OR BY SETTING UP A CALL TO A SUBROUTINE
17 CC
18  COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),bin(4),
19  &maxfin,relup,relerr,reler2,fcnmax
20  REAL xkin,ukin,wkin,ain,bin,relerr,relup,reler2,fcnmax
21  INTEGER maxfin
22  SAVE /lminui/
23 
24  COMMON /lpflag/ lst3
25  INTEGER lst3
26  SAVE /lpflag/
27 
28 
29  COMMON
30  1/lmmine/ erp(30) ,ern(30)
31  2/lmpari/ x(15) ,xt(15) ,dirin(15) ,maxint ,npar
32  3/lmpare/ u(30) ,werr(30) ,maxext ,nu
33  4/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
34  5/lmvari/ v(15,15)
35  7/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
36  7/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
37  c/lmcasc/ y(16) ,jh ,jl
38  f/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
39  g/lmsimv/ p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
40  j/lmvart/ vt(15,15)
41  COMMON
42  6/lmunit/ isysrd ,isyswr ,isyspu
43  8/lmtitl/ title(13),date(2) ,isw(7) ,nblock
44  9/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
45  a/lmcard/ cword ,cword2 ,cword3 ,word7(7)
46  b/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
47 
48  REAL erp,ern
49  INTEGER maxint,npar
50  REAL x,xt,dirin
51  INTEGER maxext ,nu
52  REAL u,werr
53  INTEGER lcode,lcorsp,limset
54  REAL alim,blim
55  REAL v
56  INTEGER ipfix,npfix
57  REAL xs,xts,dirins
58  REAL grds,g2s,gsteps,aberfs
59  REAL y
60  INTEGER jh,jl
61  REAL gin,grd,g2,gstep,aberf
62  REAL p,pstar,pstst,pbar,prho
63  REAL vt
64 ***** COMMON
65  INTEGER isysrd ,isyswr ,isyspu
66  REAL title,date
67  INTEGER isw,nblock
68  REAL epsi ,apsi ,vtest
69  INTEGER nstepq ,nfcn ,nfcnmx
70  REAL cword ,cword2 ,cword3 ,word7
71  REAL amin ,up ,sigma,epsmac
72  INTEGER newmin ,itaur
73  INTEGER it,iflag
74  REAL fval3,fmax,f
75 
76  fval3 = 2.0*amin+1.0
77 C . . . . . . . . . . ERROR DEF
78  word7(1)=relup*abs(amin)
79  up = word7(1)
80  IF (up .LE. 0.) up = 1.0
81  IF (isw(2) .GE. 1) CALL lmprin(1,amin)
82  word7(1)=maxfin
83  word7(2)=relerr*up
84  nfcnmx = word7(1) + 0.5
85  IF (nfcnmx .LE. 0) nfcnmx = 1000
86  epsi = word7(2)
87  IF (epsi .LE. 0.) epsi = 0.1 * up
88  newmin = 0
89  itaur = 0
90  isw(1) = 0
91  CALL lmsimp
92  IF(abs(dirin(1)).LE.abs(epsmac*x(1)).AND.
93  & abs(dirin(2)).LE.abs(epsmac*x(2))) THEN
94  IF(lst3.GE.1) WRITE(6,2100)
95  goto 500
96  ENDIF
97  word7(1)=maxfin
98  relerr=reler2*relerr
99  word7(2)=relerr*up
100  nfcnmx = word7(1) + 0.5
101  IF (nfcnmx .LE. 0) nfcnmx = 1000
102  epsi = word7(2)
103  IF (epsi .LE. 0.) epsi = 0.1 * up
104  CALL lmsimp
105  500 fcnmax=abs(amin)
106  IF(isw(1).GE.1) THEN
107  IF(lst3.GE.1) WRITE(6,2200)
108  fcnmax=fcnmax*1.25
109  ENDIF
110  fmax=abs(amin)
111 C . . . . . . . . . . END, EXIT
112  word7(1)=0.
113  1100 it = word7(1) + 0.5
114  IF (fval3 .EQ. amin .OR. it .GT. 0) RETURN
115  iflag = 3
116  CALL lsigmx(npar,gin,f,u,iflag)
117  nfcn = nfcn + 1
118  IF(lst3.GE.1.AND.abs(f).GT.fmax) WRITE(6,2300) f
119  RETURN
120 
121  2100 FORMAT(' Warning: Stepsizes are less than machine accuracy ',
122  &'times variable values. No further minimization attempted.')
123  2200 FORMAT(' Warning: Simplex minimization has not converged ',
124  &'properly.',/,10x,'Returned maximum increased by a factor 1.25.')
125  2300 FORMAT(' Warning from LMCMND: function at minimum, ',e12.4,
126  &' is smaller than stored minimum.')
127 
128  END