source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnexcm.F@ 2403

Last change on this file since 2403 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: 15.4 KB
RevLine 
[2403]1*
2* $Id: mnexcm.F,v 1.1.1.1 2003-06-11 14:18:27 cmv Exp $
3*
4* $Log: not supported by cvs2svn $
5* Revision 1.2 1996/03/15 18:02:45 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:29 mclareni
21* Minuit
22*
23*
24#include "minuit/pilot.h"
25 SUBROUTINE MNEXCM(FCN,COMAND,PLIST,LLIST,IERFLG,FUTIL)
26#include "minuit/d506dp.inc"
27CC Interprets a command and takes appropriate action,
28CC either directly by skipping to the corresponding code in
29CC MNEXCM, or by setting up a call to a subroutine
30CC
31#include "minuit/d506cm.inc"
32 EXTERNAL FCN,FUTIL
33 CHARACTER*(*) COMAND
34C Cannot say DIMENSION PLIST(LLIST) since LLIST can be =0.
35 DIMENSION PLIST(*)
36 PARAMETER (MXPT=101)
37 DIMENSION XPTU(MXPT), YPTU(MXPT)
38C alphabetical order of command names!
39 CHARACTER*10 CNAME(40), CNEWAY, CHWHY*18, C26*30, CVBLNK*2
40 LOGICAL LTOFIX, LFIXED, LFREED
41C
42 CHARACTER COMD*4
43 CHARACTER CLOWER*26, CUPPER*26
44 DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
45 DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
46C
47C recognized MINUIT commands:
48 DATA CNAME( 1) / 'MINImize ' /
49 DATA CNAME( 2) / 'SEEk ' /
50 DATA CNAME( 3) / 'SIMplex ' /
51 DATA CNAME( 4) / 'MIGrad ' /
52 DATA CNAME( 5) / 'MINOs ' /
53 DATA CNAME( 6) / 'SET xxx ' /
54 DATA CNAME( 7) / 'SHOw xxx ' /
55 DATA CNAME( 8) / 'TOP of pag' /
56 DATA CNAME( 9) / 'FIX ' /
57 DATA CNAME(10) / 'REStore ' /
58 DATA CNAME(11) / 'RELease ' /
59 DATA CNAME(12) / 'SCAn ' /
60 DATA CNAME(13) / 'CONtour ' /
61 DATA CNAME(14) / 'HESse ' /
62 DATA CNAME(15) / 'SAVe ' /
63 DATA CNAME(16) / 'IMProve ' /
64 DATA CNAME(17) / 'CALl fcn ' /
65 DATA CNAME(18) / 'STAndard ' /
66 DATA CNAME(19) / 'END ' /
67 DATA CNAME(20) / 'EXIt ' /
68 DATA CNAME(21) / 'RETurn ' /
69 DATA CNAME(22) / 'CLEar ' /
70 DATA CNAME(23) / 'HELP ' /
71 DATA CNAME(24) / 'MNContour ' /
72 DATA CNAME(25) / 'STOp ' /
73 DATA CNAME(26) / 'JUMp ' /
74 DATA CNAME(27) / ' ' /
75 DATA CNAME(28) / ' ' /
76 DATA CNAME(29) / ' ' /
77 DATA CNAME(30) / ' ' /
78 DATA CNAME(31) / ' ' /
79 DATA CNAME(32) / ' ' /
80 DATA CNAME(33) / ' ' /
81C obsolete commands:
82 DATA CNAME(34) / 'COVARIANCE' /
83 DATA CNAME(35) / 'PRINTOUT ' /
84 DATA CNAME(36) / 'GRADIENT ' /
85 DATA CNAME(37) / 'MATOUT ' /
86 DATA CNAME(38) / 'ERROR DEF ' /
87 DATA CNAME(39) / 'LIMITS ' /
88 DATA CNAME(40) / 'PUNCH ' /
89 DATA NNTOT/40/
90C IERFLG is now (94.5) defined the same as ICONDN in MNCOMD
91CC = 0: command executed normally
92CC 1: command is blank, ignored
93CC 2: command line unreadable, ignored
94CC 3: unknown command, ignored
95CC 4: abnormal termination (e.g., MIGRAD not converged)
96CC 9: reserved
97CC 10: END command
98CC 11: EXIT or STOP command
99CC 12: RETURN command
100 LK = LEN(COMAND)
101 IF (LK .GT. MAXCWD) LK=MAXCWD
102 CWORD = COMAND(1:LK)
103C get upper case
104 DO 16 ICOL= 1, LK
105 DO 15 LET= 1, 26
106 IF (CWORD(ICOL:ICOL) .EQ. CLOWER(LET:LET))
107 + CWORD(ICOL:ICOL) = CUPPER(LET:LET)
108 15 CONTINUE
109 16 CONTINUE
110C Copy the first MAXP arguments into COMMON (WORD7), making
111C sure that WORD7(1)=0. if LLIST=0
112 DO 20 IW= 1, MAXP
113 WORD7(IW) = ZERO
114 IF (IW .LE. LLIST) WORD7(IW) = PLIST(IW)
115 20 CONTINUE
116 ICOMND = ICOMND + 1
117 NFCNLC = NFCN
118 IF (CWORD(1:7).NE.'SET PRI' .OR. WORD7(1).GE.0.) THEN
119 IF (ISW(5) .GE. 0) THEN
120 LNOW = LLIST
121 IF (LNOW .GT. 4) LNOW=4
122 WRITE (ISYSWR,25) ICOMND,CWORD(1:LK),(PLIST(I),I=1,LNOW)
123 25 FORMAT (1H ,10(1H*)/' **',I5,' **',A,4G12.4)
124 INONDE = 0
125 IF (LLIST .GT. LNOW) THEN
126 KLL = LLIST
127 IF (LLIST .GT. MAXP) THEN
128 INONDE = 1
129 KLL = MAXP
130 ENDIF
131 WRITE (CVBLNK,'(I2)') LK
132 C26 = '(11H **********,'//CVBLNK//'X,4G12.4)'
133 WRITE (ISYSWR,C26) (PLIST(I),I=LNOW+1,KLL)
134 ENDIF
135 WRITE (ISYSWR, '(1H ,10(1H*))' )
136 IF (INONDE .GT. 0) WRITE (ISYSWR, '(1H ,10(1H*),A,I3,A)')
137 + ' ERROR: ABOVE CALL TO MNEXCM TRIED TO PASS MORE THAN ',
138 + MAXP,' PARAMETERS.'
139 ENDIF
140 ENDIF
141 NFCNMX = WORD7(1)
142 IF (NFCNMX .LE. 0) NFCNMX = 200 + 100*NPAR + 5*NPAR**2
143 EPSI = WORD7(2)
144 IF (EPSI .LE. ZERO) EPSI = 0.1 * UP
145 LNEWMN = .FALSE.
146 LPHEAD = .TRUE.
147 ISW(1) = 0
148 IERFLG = 0
149C look for command in list CNAME . . . . . . . . . .
150 DO 80 I= 1, NNTOT
151 IF (CWORD(1:3) .EQ. CNAME(I)(1:3)) GO TO 90
152 80 CONTINUE
153 WRITE (ISYSWR,'(11X,''UNKNOWN COMMAND IGNORED:'',A)') COMAND
154 IERFLG = 3
155 GO TO 5000
156C normal case: recognized MINUIT command . . . . . . .
157 90 CONTINUE
158 IF (CWORD(1:4) .EQ. 'MINO') I = 5
159 IF (I.NE.6 .AND. I.NE.7 .AND. I.NE.8 .AND. I.NE.23) THEN
160 CFROM = CNAME(I)
161 NFCNFR = NFCN
162 ENDIF
163C 1 2 3 4 5 6 7 8 9 10
164 GO TO ( 400, 200, 300, 400, 500, 700, 700, 800, 900,1000,
165 1 1100,1200,1300,1400,1500,1600,1700,1800,1900,1900,
166 2 1900,2200,2300,2400,1900,2600,3300,3300,3300,3300,
167 3 3300,3300,3300,3400,3500,3600,3700,3800,3900,4000) , I
168C . . . . . . . . . . seek
169 200 CALL MNSEEK(FCN,FUTIL)
170 GO TO 5000
171C . . . . . . . . . . simplex
172 300 CALL MNSIMP(FCN,FUTIL)
173 IF (ISW(4) .LT. 1) IERFLG = 4
174 GO TO 5000
175C . . . . . . migrad, minimize
176 400 CONTINUE
177 NF = NFCN
178 APSI = EPSI
179 CALL MNMIGR(FCN,FUTIL)
180 CALL MNWERR
181 IF (ISW(4) .GE. 1) GO TO 5000
182 IERFLG = 4
183 IF (ISW(1) .EQ. 1) GO TO 5000
184 IF (CWORD(1:3) .EQ. 'MIG') GO TO 5000
185 NFCNMX = NFCNMX + NF - NFCN
186 NF = NFCN
187 CALL MNSIMP(FCN,FUTIL)
188 IF (ISW(1) .EQ. 1) GO TO 5000
189 NFCNMX = NFCNMX + NF - NFCN
190 CALL MNMIGR(FCN,FUTIL)
191 IF (ISW(4) .GE. 1) IERFLG = 0
192 CALL MNWERR
193 GO TO 5000
194C . . . . . . . . . . minos
195 500 CONTINUE
196 NSUPER = NFCN + 2*(NPAR+1)*NFCNMX
197C possible loop over new minima
198 EPSI = 0.1 * UP
199 510 CONTINUE
200 CALL MNCUVE(FCN,FUTIL)
201 CALL MNMNOS(FCN,FUTIL)
202 IF (.NOT. LNEWMN) GO TO 5000
203 CALL MNRSET(0)
204 CALL MNMIGR(FCN,FUTIL)
205 CALL MNWERR
206 IF (NFCN .LT. NSUPER) GO TO 510
207 WRITE (ISYSWR,'(/'' TOO MANY FUNCTION CALLS. MINOS GIVES UP''/)')
208 IERFLG = 4
209 GO TO 5000
210C . . . . . . . . . .set, show
211 700 CALL MNSET(FCN,FUTIL)
212 GO TO 5000
213C . . . . . . . . . . top of page
214 800 CONTINUE
215 WRITE (ISYSWR,'(1H1)')
216 GO TO 5000
217C . . . . . . . . . . fix
218 900 LTOFIX = .TRUE.
219C . . (also release) ....
220 901 CONTINUE
221 LFREED = .FALSE.
222 LFIXED = .FALSE.
223 IF (LLIST .EQ. 0) THEN
224 WRITE (ISYSWR,'(A,A)') CWORD,': NO PARAMETERS REQUESTED '
225 GO TO 5000
226 ENDIF
227 DO 950 ILIST= 1, LLIST
228 IEXT = PLIST(ILIST)
229 CHWHY = ' IS UNDEFINED.'
230 IF (IEXT .LE. 0) GO TO 930
231 IF (IEXT .GT. NU) GO TO 930
232 IF (NVARL(IEXT) .LT. 0) GO TO 930
233 CHWHY = ' IS CONSTANT. '
234 IF (NVARL(IEXT) .EQ. 0) GO TO 930
235 IINT = NIOFEX(IEXT)
236 IF (LTOFIX) THEN
237 CHWHY = ' ALREADY FIXED.'
238 IF (IINT .EQ. 0) GO TO 930
239 CALL MNFIXP(IINT,IERR)
240 IF (IERR .EQ. 0) THEN
241 LFIXED = .TRUE.
242 ELSE
243 IERFLG = 4
244 ENDIF
245 ELSE
246 CHWHY = ' ALREADY VARIABLE.'
247 IF (IINT .GT. 0) GO TO 930
248 KRL = -IABS(IEXT)
249 CALL MNFREE(KRL)
250 LFREED = .TRUE.
251 ENDIF
252 GO TO 950
253 930 WRITE (ISYSWR,'(A,I4,A,A)') ' PARAMETER',IEXT,CHWHY,' IGNORED.'
254 950 CONTINUE
255 IF (LFREED .OR. LFIXED) CALL MNRSET(0)
256 IF (LFREED) THEN
257 ISW(2) = 0
258 DCOVAR = 1.
259 EDM = BIGEDM
260 ISW(4) = 0
261 ENDIF
262 CALL MNWERR
263 IF (ISW(5) .GT. 1) CALL MNPRIN(5,AMIN)
264 GO TO 5000
265C . . . . . . . . . . restore
266 1000 IT = WORD7(1)
267 IF (IT.GT.1 .OR. IT.LT.0) GO TO 1005
268 LFREED = (NPFIX .GT. 0)
269 CALL MNFREE(IT)
270 IF (LFREED) THEN
271 CALL MNRSET(0)
272 ISW(2) = 0
273 DCOVAR = 1.
274 EDM = BIGEDM
275 ENDIF
276 GO TO 5000
277 1005 WRITE (ISYSWR,'(A,I4)') ' IGNORED. UNKNOWN ARGUMENT:',IT
278 IERFLG = 3
279 GO TO 5000
280C . . . . . . . . . . release
281 1100 LTOFIX = .FALSE.
282 GO TO 901
283C . . . . . . . . . . scan . . .
284 1200 CONTINUE
285 IEXT = WORD7(1)
286 IF (IEXT .LE. 0) GO TO 1210
287 IT2 = 0
288 IF (IEXT .LE. NU) IT2 = NIOFEX(IEXT)
289 IF (IT2 .LE. 0) GO TO 1250
290 1210 CALL MNSCAN(FCN,FUTIL)
291 GO TO 5000
292 1250 WRITE (ISYSWR,'(A,I4,A)') ' PARAMETER',IEXT,' NOT VARIABLE.'
293 IERFLG = 3
294 GO TO 5000
295C . . . . . . . . . . contour
296 1300 CONTINUE
297 KE1 = WORD7(1)
298 KE2 = WORD7(2)
299 IF (KE1 .EQ. 0) THEN
300 IF (NPAR .EQ. 2) THEN
301 KE1 = NEXOFI(1)
302 KE2 = NEXOFI(2)
303 ELSE
304 WRITE (ISYSWR,'(A,A)') CWORD,': NO PARAMETERS REQUESTED '
305 IERFLG = 3
306 GO TO 5000
307 ENDIF
308 ENDIF
309 NFCNMX = 1000
310 CALL MNCNTR(FCN,KE1,KE2,IERRF,FUTIL)
311 IF (IERRF .GT. 0) IERFLG = 3
312 GO TO 5000
313C . . . . . . . . . . hesse
314 1400 CONTINUE
315 CALL MNHESS(FCN,FUTIL)
316 CALL MNWERR
317 IF (ISW(5) .GE. 0) CALL MNPRIN(2, AMIN)
318 IF (ISW(5) .GE. 1) CALL MNMATU(1)
319 GO TO 5000
320C . . . . . . . . . . save
321 1500 CONTINUE
322 CALL MNSAVE
323 GO TO 5000
324C . . . . . . . . . . improve
325 1600 CONTINUE
326 CALL MNCUVE(FCN,FUTIL)
327 CALL MNIMPR(FCN,FUTIL)
328 IF (LNEWMN) GO TO 400
329 IERFLG = 4
330 GO TO 5000
331C . . . . . . . . . . call fcn
332 1700 IFLAG = WORD7(1)
333 NPARX = NPAR
334 F = UNDEFI
335 CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
336 NFCN = NFCN + 1
337 NOWPRT = 0
338 IF (F .NE. UNDEFI) THEN
339 IF (AMIN .EQ. UNDEFI) THEN
340 AMIN = F
341 NOWPRT = 1
342 ELSE IF (F .LT. AMIN) THEN
343 AMIN = F
344 NOWPRT = 1
345 ENDIF
346 IF (ISW(5).GE.0 .AND. IFLAG.LE.5 .AND. NOWPRT.EQ.1)
347 + CALL MNPRIN(5,AMIN)
348 IF (IFLAG .EQ. 3) FVAL3=F
349 ENDIF
350 IF (IFLAG .GT. 5) CALL MNRSET(1)
351 GO TO 5000
352C . . . . . . . . . . standard
353 1800 CALL STAND
354 GO TO 5000
355C . . . return, stop, end, exit
356 1900 IT = WORD7(1)
357 IF (FVAL3 .NE. AMIN .AND. IT .EQ. 0) THEN
358 IFLAG = 3
359 IF (ISW(5) .GE. 0)
360 +WRITE (ISYSWR,'(/A/)') ' CALL TO USER FUNCTION WITH IFLAG = 3'
361 NPARX = NPAR
362 CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
363 NFCN = NFCN + 1
364 FVAL3 = F
365 ENDIF
366 IERFLG = 11
367 IF (CWORD(1:3) .EQ. 'END') IERFLG = 10
368 IF (CWORD(1:3) .EQ. 'RET') IERFLG = 12
369 GO TO 5000
370C . . . . . . . . . . clear
371 2200 CONTINUE
372 CALL MNCLER
373 IF (ISW(5) .GE. 1) WRITE (ISYSWR,'(A)')
374 + ' MINUIT MEMORY CLEARED. NO PARAMETERS NOW DEFINED.'
375 GO TO 5000
376C . . . . . . . . . . help
377 2300 CONTINUE
378CCCC IF (INDEX(CWORD,'SHO') .GT. 0) GO TO 700
379CCCC IF (INDEX(CWORD,'SET') .GT. 0) GO TO 700
380 KCOL = 0
381 DO 2310 ICOL= 5,LK
382 IF (CWORD(ICOL:ICOL) .EQ. ' ') GO TO 2310
383 KCOL = ICOL
384 GO TO 2320
385 2310 CONTINUE
386 2320 CONTINUE
387 IF (KCOL .EQ. 0) THEN
388 COMD = '* '
389 ELSE
390 COMD = CWORD(KCOL:LK)
391 ENDIF
392 CALL MNHELP(COMD,ISYSWR)
393 GO TO 5000
394C . . . . . . . . . . MNContour
395 2400 CONTINUE
396 EPSI = 0.05 * UP
397 KE1 = WORD7(1)
398 KE2 = WORD7(2)
399 IF (KE1.EQ.0 .AND. NPAR.EQ.2) THEN
400 KE1 = NEXOFI(1)
401 KE2 = NEXOFI(2)
402 ENDIF
403 NPTU = WORD7(3)
404 IF (NPTU .LE. 0) NPTU=20
405 IF (NPTU .GT. MXPT) NPTU = MXPT
406 NFCNMX = 100*(NPTU+5)*(NPAR+1)
407 CALL MNCONT(FCN,KE1,KE2,NPTU,XPTU,YPTU,IERRF,FUTIL)
408 IF (IERRF .LT. NPTU) IERFLG = 4
409 IF (IERRF .EQ. -1) IERFLG = 3
410 GO TO 5000
411C . . . . . . . . . . jump
412 2600 CONTINUE
413 STEP = WORD7(1)
414 IF (STEP .LE. ZERO) STEP = 2.
415 RNO = 0.
416 IZERO = 0
417 DO 2620 I= 1, NPAR
418 CALL MNRN15(RNO,IZERO)
419 RNO = 2.0*RNO - 1.0
420 2620 X(I) = X(I) + RNO*STEP*WERR(I)
421 CALL MNINEX(X)
422 CALL MNAMIN(FCN,FUTIL)
423 CALL MNRSET(0)
424 GO TO 5000
425C . . . . . . . . . . blank line
426 3300 CONTINUE
427 WRITE (ISYSWR,'(10X,A)') ' BLANK COMMAND IGNORED.'
428 IERFLG = 1
429 GO TO 5000
430C . . . . . . . . obsolete commands . . . . . . . . . . . . . .
431C . . . . . . . . . . covariance
432 3400 CONTINUE
433 WRITE (ISYSWR, '(A)') ' THE "COVARIANCE" COMMAND IS OSBSOLETE.',
434 + ' THE COVARIANCE MATRIX IS NOW SAVED IN A DIFFERENT FORMAT',
435 + ' WITH THE "SAVE" COMMAND AND READ IN WITH:"SET COVARIANCE"'
436 IERFLG = 3
437 GO TO 5000
438C . . . . . . . . . . printout
439 3500 CONTINUE
440 CNEWAY = 'SET PRInt '
441 GO TO 3100
442C . . . . . . . . . . gradient
443 3600 CONTINUE
444 CNEWAY = 'SET GRAd '
445 GO TO 3100
446C . . . . . . . . . . matout
447 3700 CONTINUE
448 CNEWAY = 'SHOW COVar'
449 GO TO 3100
450C . . . . . . . . . error def
451 3800 CONTINUE
452 CNEWAY = 'SET ERRdef'
453 GO TO 3100
454C . . . . . . . . . . limits
455 3900 CONTINUE
456 CNEWAY = 'SET LIMits'
457 GO TO 3100
458C . . . . . . . . . . punch
459 4000 CONTINUE
460 CNEWAY = 'SAVE '
461C ....... come from obsolete commands
462 3100 WRITE (ISYSWR, 3101) CWORD,CNEWAY
463 3101 FORMAT (' OBSOLETE COMMAND:',1X,A10,5X,'PLEASE USE:',1X,A10)
464 CWORD = CNEWAY
465 IF (CWORD .EQ. 'SAVE ') GO TO 1500
466 GO TO 700
467C . . . . . . . . . . . . . . . . . .
468 5000 RETURN
469 END
Note: See TracBrowser for help on using the repository browser.