source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnparm.F@ 3891

Last change on this file since 3891 was 2403, checked in by cmv, 22 years ago

Creation du module de code source de MINUIT (CERNLIB) extrait par CMV

cmv 11/06/2003
File size: 7.5 KB
Line 
1*
2* $Id: mnparm.F,v 1.1.1.1 2003-06-11 14:18:28 cmv Exp $
3*
4* $Log: not supported by cvs2svn $
5* Revision 1.2 1996/03/15 18:02:50 james
6* Modified Files:
7* mnderi.F eliminate possible division by zero
8* mnexcm.F suppress print on STOP when print flag=-1
9* set FVAL3 to flag if FCN already called with IFLAG=3
10* mninit.F set version 96.03
11* mnlims.F remove arguments, not needed
12* mnmigr.F VLEN -> LENV in debug print statement
13* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
14* mnpsdf.F eliminate possible division by zero
15* mnscan.F suppress printout when print flag =-1
16* mnset.F remove arguments in call to MNLIMS
17* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
18* mnvert.F eliminate possible division by zero
19*
20* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
21* Minuit
22*
23*
24#include "minuit/pilot.h"
25 SUBROUTINE MNPARM(K,CNAMJ,UK,WK,A,B,IERFLG)
26#include "minuit/d506dp.inc"
27CC Called from MNPARS and user-callable
28CC Implements one parameter definition, that is:
29CC K (external) parameter number
30CC CNAMK parameter name
31CC UK starting value
32CC WK starting step size or uncertainty
33CC A, B lower and upper physical parameter limits
34CC and sets up (updates) the parameter lists.
35CC Output: IERFLG=0 if no problems
36CC >0 if MNPARM unable to implement definition
37CC
38#include "minuit/d506cm.inc"
39 CHARACTER*(*) CNAMJ
40 CHARACTER CNAMK*10, CHBUFI*4
41C
42 CNAMK = CNAMJ
43 KINT = NPAR
44 IF (K.LT.1 .OR. K.GT.MAXEXT) THEN
45C parameter number exceeds allowed maximum value
46 WRITE (ISYSWR,9) K,MAXEXT
47 9 FORMAT (/' MINUIT USER ERROR. PARAMETER NUMBER IS',I11/
48 + ', ALLOWED RANGE IS ONE TO',I4/)
49 GO TO 800
50 ENDIF
51C normal parameter request
52 KTOFIX = 0
53 IF (NVARL(K) .LT. 0) GO TO 50
54C previously defined parameter is being redefined
55C find if parameter was fixed
56 DO 40 IX= 1, NPFIX
57 IF (IPFIX(IX) .EQ. K) KTOFIX = K
58 40 CONTINUE
59 IF (KTOFIX .GT. 0) THEN
60 CALL MNWARN('W','PARAM DEF','REDEFINING A FIXED PARAMETER.')
61 IF (KINT .GE. MAXINT) THEN
62 WRITE (ISYSWR,'(A)') ' CANNOT RELEASE. MAX NPAR EXCEEDED.'
63 GO TO 800
64 ENDIF
65 CALL MNFREE(-K)
66 ENDIF
67C if redefining previously variable parameter
68 IF(NIOFEX(K) .GT. 0) KINT = NPAR-1
69 50 CONTINUE
70C
71C . . .print heading
72 IF (LPHEAD .AND. ISW(5).GE.0) THEN
73 WRITE (ISYSWR,61)
74 LPHEAD = .FALSE.
75 ENDIF
76 61 FORMAT(/' PARAMETER DEFINITIONS:'/
77 + ' NO. NAME VALUE STEP SIZE LIMITS')
78 IF (WK .GT. ZERO) GO TO 122
79C . . .constant parameter . . . .
80 IF (ISW(5) .GE. 0) WRITE (ISYSWR, 82) K,CNAMK,UK
81 82 FORMAT (1X,I5,1X,1H',A10,1H',1X,G13.5, ' constant')
82 NVL = 0
83 GO TO 200
84 122 IF (A.EQ.ZERO .AND. B.EQ.ZERO) THEN
85C variable parameter without limits
86 NVL = 1
87 IF (ISW(5) .GE. 0) WRITE (ISYSWR, 127) K,CNAMK,UK,WK
88 127 FORMAT (1X,I5,1X,1H',A10,1H',1X,2G13.5, ' no limits')
89 ELSE
90C variable parameter with limits
91 NVL = 4
92 LNOLIM = .FALSE.
93 IF (ISW(5) .GE. 0) WRITE (ISYSWR, 132) K,CNAMK,UK,WK,A,B
94 132 FORMAT(1X,I5,1X,1H',A10,1H',1X,2G13.5,2X,2G13.5)
95 ENDIF
96C . . request for another variable parameter
97 KINT = KINT + 1
98 IF (KINT .GT. MAXINT) THEN
99 WRITE (ISYSWR,135) MAXINT
100 135 FORMAT (/' MINUIT USER ERROR. TOO MANY VARIABLE PARAMETERS.'/
101 + ' THIS VERSION OF MINUIT DIMENSIONED FOR',I4//)
102 GO TO 800
103 ENDIF
104 IF (NVL .EQ. 1) GO TO 200
105 IF (A .EQ. B) THEN
106 WRITE (ISYSWR,'(/A,A/A/)') ' USER ERROR IN MINUIT PARAMETER',
107 + ' DEFINITION',' UPPER AND LOWER LIMITS EQUAL.'
108 GO TO 800
109 ENDIF
110 IF (B .LT. A) THEN
111 SAV = B
112 B = A
113 A = SAV
114 CALL MNWARN('W','PARAM DEF','PARAMETER LIMITS WERE REVERSED.')
115 IF (LWARN) LPHEAD=.TRUE.
116 ENDIF
117 IF ((B-A) .GT. 1.0E7) THEN
118 WRITE (CHBUFI,'(I4)') K
119 CALL MNWARN('W','PARAM DEF',
120 + 'LIMITS ON PARAM'//CHBUFI//' TOO FAR APART.')
121 IF (LWARN) LPHEAD=.TRUE.
122 ENDIF
123 DANGER = (B-UK)*(UK-A)
124 IF (DANGER .LT. 0.)
125 + CALL MNWARN('W','PARAM DEF','STARTING VALUE OUTSIDE LIMITS.')
126 IF (DANGER .EQ. 0.)
127 + CALL MNWARN('W','PARAM DEF','STARTING VALUE IS AT LIMIT.')
128 200 CONTINUE
129C . . . input OK, set values, arrange lists,
130C calculate step sizes GSTEP, DIRIN
131 CFROM = 'PARAMETR'
132 NFCNFR = NFCN
133 CSTATU= 'NEW VALUES'
134 NU = MAX(NU,K)
135 CPNAM(K) = CNAMK
136 U(K) = UK
137 ALIM(K) = A
138 BLIM(K) = B
139 NVARL(K) = NVL
140C K is external number of new parameter
141C LASTIN is the number of var. params with ext. param. no.< K
142 LASTIN = 0
143 DO 240 IX= 1, K-1
144 IF (NIOFEX(IX) .GT. 0) LASTIN=LASTIN+1
145 240 CONTINUE
146C KINT is new number of variable params, NPAR is old
147 IF (KINT .EQ. NPAR) GO TO 280
148 IF (KINT .GT. NPAR) THEN
149C insert new variable parameter in list
150 DO 260 IN= NPAR,LASTIN+1,-1
151 IX = NEXOFI(IN)
152 NIOFEX(IX) = IN+1
153 NEXOFI(IN+1)= IX
154 X (IN+1) = X (IN)
155 XT (IN+1) = XT (IN)
156 DIRIN(IN+1) = DIRIN(IN)
157 G2 (IN+1) = G2 (IN)
158 GSTEP(IN+1) = GSTEP(IN)
159 260 CONTINUE
160 ELSE
161C remove variable parameter from list
162 DO 270 IN= LASTIN+1,KINT
163 IX = NEXOFI(IN+1)
164 NIOFEX(IX) = IN
165 NEXOFI(IN)= IX
166 X (IN)= X (IN+1)
167 XT (IN)= XT (IN+1)
168 DIRIN (IN)= DIRIN(IN+1)
169 G2 (IN)= G2 (IN+1)
170 GSTEP (IN)= GSTEP(IN+1)
171 270 CONTINUE
172 ENDIF
173 280 CONTINUE
174 IX = K
175 NIOFEX(IX) = 0
176 NPAR = KINT
177 CALL MNRSET(1)
178C lists are now arranged . . . .
179 IF (NVL .GT. 0) THEN
180 IN = LASTIN+1
181 NEXOFI(IN) = IX
182 NIOFEX(IX) = IN
183 SAV = U(IX)
184 CALL MNPINT(SAV,IX,PINTI)
185 X(IN) = PINTI
186 XT(IN) = X(IN)
187 WERR(IN) = WK
188 SAV2 = SAV + WK
189 CALL MNPINT(SAV2,IX,PINTI)
190 VPLU = PINTI - X(IN)
191 SAV2 = SAV - WK
192 CALL MNPINT(SAV2,IX,PINTI)
193 VMINU = PINTI - X(IN)
194 DIRIN(IN) = 0.5 * (ABS(VPLU) +ABS(VMINU))
195 G2(IN) = 2.0*UP / DIRIN(IN)**2
196 GSMIN = 8.*EPSMA2*ABS(X(IN))
197 GSTEP(IN) = MAX (GSMIN, 0.1*DIRIN(IN))
198 IF (AMIN .NE. UNDEFI) THEN
199 SMALL = SQRT(EPSMA2*(AMIN+UP)/UP)
200 GSTEP(IN) = MAX(GSMIN, SMALL*DIRIN(IN))
201 ENDIF
202 GRD (IN) = G2(IN)*DIRIN(IN)
203C if parameter has limits
204 IF (NVARL(K) .GT. 1) THEN
205 IF (GSTEP(IN).GT. 0.5) GSTEP(IN)=0.5
206 GSTEP(IN) = -GSTEP(IN)
207 ENDIF
208 ENDIF
209 IF (KTOFIX .GT. 0) THEN
210 KINFIX = NIOFEX(KTOFIX)
211 IF (KINFIX .GT. 0) CALL MNFIXP(KINFIX,IERR)
212 IF (IERR .GT. 0) GO TO 800
213 ENDIF
214 IERFLG = 0
215 RETURN
216C error on input, unable to implement request . . . .
217 800 CONTINUE
218 IERFLG = 1
219 RETURN
220 END
Note: See TracBrowser for help on using the repository browser.