source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnset.F@ 3076

Last change on this file since 3076 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.5 KB
Line 
1*
2* $Id: mnset.F,v 1.1.1.1 2003-06-11 14:18:29 cmv Exp $
3*
4* $Log: not supported by cvs2svn $
5* Revision 1.2 1996/03/15 18:02:52 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 MNSET(FCN,FUTIL)
26#include "minuit/d506dp.inc"
27CC Called from MNEXCM
28CC Interprets the commands that start with SET and SHOW
29CC
30#include "minuit/d506cm.inc"
31C
32 EXTERNAL FCN,FUTIL
33C file characteristics for SET INPUT
34 LOGICAL LNAME
35 CHARACTER CFNAME*64, CMODE*16
36C 'SET ' or 'SHOW', 'ON ' or 'OFF', 'SUPPRESSED' or 'REPORTED '
37 CHARACTER CKIND*4, COPT*3, CWARN*10
38C explanation of print level numbers -1:3 and strategies 0:2
39 CHARACTER CPRLEV(-1:3)*34 ,CSTRAT(0:2)*44
40C identification of debug options
41 PARAMETER (NUMDBG = 6)
42 CHARACTER*40 CDBOPT(0:NUMDBG)
43C things that can be set or shown
44 CHARACTER*10 CNAME(30)
45 DATA CNAME( 1)/'FCN value '/
46 DATA CNAME( 2)/'PARameters'/
47 DATA CNAME( 3)/'LIMits '/
48 DATA CNAME( 4)/'COVariance'/
49 DATA CNAME( 5)/'CORrelatio'/
50 DATA CNAME( 6)/'PRInt levl'/
51 DATA CNAME( 7)/'NOGradient'/
52 DATA CNAME( 8)/'GRAdient '/
53 DATA CNAME( 9)/'ERRor def '/
54 DATA CNAME(10)/'INPut file'/
55 DATA CNAME(11)/'WIDth page'/
56 DATA CNAME(12)/'LINes page'/
57 DATA CNAME(13)/'NOWarnings'/
58 DATA CNAME(14)/'WARnings '/
59 DATA CNAME(15)/'RANdom gen'/
60 DATA CNAME(16)/'TITle '/
61 DATA CNAME(17)/'STRategy '/
62 DATA CNAME(18)/'EIGenvalue'/
63 DATA CNAME(19)/'PAGe throw'/
64 DATA CNAME(20)/'MINos errs'/
65 DATA CNAME(21)/'EPSmachine'/
66 DATA CNAME(22)/'OUTputfile'/
67 DATA CNAME(23)/'BATch '/
68 DATA CNAME(24)/'INTeractiv'/
69 DATA CNAME(25)/'VERsion '/
70 DATA NNAME/25/
71C options not intended for normal users
72 DATA CNAME(26)/'reserve '/
73 DATA CNAME(27)/'NODebug '/
74 DATA CNAME(28)/'DEBug '/
75 DATA CNAME(29)/'SHOw '/
76 DATA CNAME(30)/'SET '/
77 DATA NNTOT/30/
78C
79 DATA CPRLEV(-1)/'-1: NO OUTPUT EXCEPT FROM "SHOW" '/
80 DATA CPRLEV( 0)/' 0: REDUCED OUTPUT '/
81 DATA CPRLEV( 1)/' 1: NORMAL OUTPUT '/
82 DATA CPRLEV( 2)/' 2: EXTRA OUTPUT FOR PROBLEM CASES'/
83 DATA CPRLEV( 3)/' 3: MAXIMUM OUTPUT '/
84C
85 DATA CSTRAT( 0)/' 0: MINIMIZE THE NUMBER OF CALLS TO FUNCTION'/
86 DATA CSTRAT( 1)/' 1: TRY TO BALANCE SPEED AGAINST RELIABILITY'/
87 DATA CSTRAT( 2)/' 2: MAKE SURE MINIMUM TRUE, ERRORS CORRECT '/
88C
89 DATA CDBOPT(0)/'REPORT ALL EXCEPTIONAL CONDITIONS '/
90 DATA CDBOPT(1)/'MNLINE: LINE SEARCH MINIMIZATION '/
91 DATA CDBOPT(2)/'MNDERI: FIRST DERIVATIVE CALCULATIONS '/
92 DATA CDBOPT(3)/'MNHESS: SECOND DERIVATIVE CALCULATIONS '/
93 DATA CDBOPT(4)/'MNMIGR: COVARIANCE MATRIX UPDATES '/
94 DATA CDBOPT(5)/'MNHES1: FIRST DERIVATIVE UNCERTAINTIES '/
95 DATA CDBOPT(6)/'MNCONT: MNCONTOUR PLOT (MNCROS SEARCH) '/
96C
97C
98 DO 2 I= 1, NNTOT
99 IF (INDEX(CWORD(4:10),CNAME(I)(1:3)) .GT. 0) GO TO 5
100 2 CONTINUE
101 I = 0
102 5 KNAME = I
103C
104C Command could be SET xxx, SHOW xxx, HELP SET or HELP SHOW
105 IF (INDEX(CWORD(1:4),'HEL') .GT. 0) GO TO 2000
106 IF (INDEX(CWORD(1:4),'SHO') .GT. 0) GO TO 1000
107 IF (INDEX(CWORD(1:4),'SET') .EQ. 0) GO TO 1900
108C ---
109 CKIND = 'SET '
110C . . . . . . . . . . set unknown
111 IF (KNAME .LE. 0) GO TO 1900
112C . . . . . . . . . . set known
113 GO TO(3000, 20, 30, 40,3000, 60, 70, 80, 90, 100,
114 + 110, 120, 130, 140, 150, 160, 170,3000, 190,3000,
115 + 210, 220, 230, 240,3000,1900, 270, 280, 290, 300) , KNAME
116C
117C . . . . . . . . . . set param
118 20 CONTINUE
119 IPRM = WORD7(1)
120 IF (IPRM .GT. NU) GO TO 25
121 IF (IPRM .LE. 0) GO TO 25
122 IF (NVARL(IPRM) .LT. 0) GO TO 25
123 U(IPRM) = WORD7(2)
124 CALL MNEXIN(X)
125 ISW2 = ISW(2)
126 CALL MNRSET(1)
127C Keep approximate covariance matrix, even if new param value
128 ISW(2) = MIN(ISW2,1)
129 CFROM = 'SET PARM'
130 NFCNFR = NFCN
131 CSTATU = 'NEW VALUES'
132 GO TO 4000
133 25 WRITE (ISYSWR,'(A/)') ' UNDEFINED PARAMETER NUMBER. IGNORED.'
134 GO TO 4000
135C . . . . . . . . . . set limits
136 30 CALL MNLIMS
137 GO TO 4000
138C . . . . . . . . . . set covar
139 40 CONTINUE
140C this command must be handled by MNREAD, and is not Fortran-callable
141 GO TO 3000
142C . . . . . . . . . . set print
143 60 ISW(5) = WORD7(1)
144 GO TO 4000
145C . . . . . . . . . . set nograd
146 70 ISW(3) = 0
147 GO TO 4000
148C . . . . . . . . . . set grad
149 80 CALL MNGRAD(FCN,FUTIL)
150 GO TO 4000
151C . . . . . . . . . . set errdef
152 90 IF (WORD7(1) .EQ. UP) GO TO 4000
153 IF (WORD7(1) .LE. ZERO) THEN
154 IF (UP .EQ. UPDFLT) GO TO 4000
155 UP = UPDFLT
156 ELSE
157 UP = WORD7(1)
158 ENDIF
159 DO 95 I= 1, NPAR
160 ERN(I) = 0.
161 95 ERP(I) = 0.
162 CALL MNWERR
163 GO TO 4000
164C . . . . . . . . . . set input
165C This command must be handled by MNREAD. If it gets this far,
166C it is illegal.
167 100 CONTINUE
168 GO TO 3000
169C . . . . . . . . . . set width
170 110 NPAGWD = WORD7(1)
171 NPAGWD = MAX(NPAGWD,50)
172 GO TO 4000
173C . . . . . . . . . . set lines
174 120 NPAGLN = WORD7(1)
175 GO TO 4000
176C . . . . . . . . . . set nowarn
177 130 LWARN = .FALSE.
178 GO TO 4000
179C . . . . . . . . . . set warn
180 140 LWARN = .TRUE.
181 CALL MNWARN('W','SHO','SHO')
182 GO TO 4000
183C . . . . . . . . . . set random
184 150 JSEED = INT(WORD7(1))
185 VAL = 3.
186 CALL MNRN15(VAL, JSEED)
187 IF (ISW(5) .GT. 0) WRITE (ISYSWR, 151) JSEED
188 151 FORMAT (' MINUIT RANDOM NUMBER SEED SET TO ',I10)
189 GO TO 4000
190C . . . . . . . . . . set title
191 160 CONTINUE
192C this command must be handled by MNREAD, and is not Fortran-callable
193 GO TO 3000
194C . . . . . . . . . set strategy
195 170 ISTRAT = WORD7(1)
196 ISTRAT = MAX(ISTRAT,0)
197 ISTRAT = MIN(ISTRAT,2)
198 IF (ISW(5) .GT. 0) GO TO 1172
199 GO TO 4000
200C . . . . . . . . . set page throw
201 190 NEWPAG = WORD7(1)
202 GO TO 1190
203C . . . . . . . . . . set epsmac
204 210 IF (WORD7(1).GT.ZERO .AND. WORD7(1).LT.0.1) EPSMAC = WORD7(1)
205 EPSMA2 = SQRT(EPSMAC)
206 GO TO 1210
207C . . . . . . . . . . set outputfile
208 220 CONTINUE
209 IUNIT = WORD7(1)
210 ISYSWR = IUNIT
211 ISTKWR(1) = IUNIT
212 IF (ISW(5) .GE. 0) GO TO 1220
213 GO TO 4000
214C . . . . . . . . . . set batch
215 230 ISW(6) = 0
216 IF (ISW(5) .GE. 0) GO TO 1100
217 GO TO 4000
218C . . . . . . . . . . set interactive
219 240 ISW(6) = 1
220 IF (ISW(5) .GE. 0) GO TO 1100
221 GO TO 4000
222C . . . . . . . . . . set nodebug
223 270 ISET = 0
224 GO TO 281
225C . . . . . . . . . . set debug
226 280 ISET = 1
227 281 CONTINUE
228 IDBOPT = WORD7(1)
229 IF (IDBOPT .GT. NUMDBG) GO TO 288
230 IF (IDBOPT .GE. 0) THEN
231 IDBG(IDBOPT) = ISET
232 IF (ISET .EQ. 1) IDBG(0) = 1
233 ELSE
234C SET DEBUG -1 sets all debug options
235 DO 285 ID= 0, NUMDBG
236 285 IDBG(ID) = ISET
237 ENDIF
238 LREPOR = (IDBG(0) .GE. 1)
239 CALL MNWARN('D','SHO','SHO')
240 GO TO 4000
241 288 WRITE (ISYSWR,289) IDBOPT
242 289 FORMAT (' UNKNOWN DEBUG OPTION',I6,' REQUESTED. IGNORED')
243 GO TO 4000
244C . . . . . . . . . . set show
245 290 CONTINUE
246C . . . . . . . . . . set set
247 300 CONTINUE
248 GO TO 3000
249C -----------------------------------------------------
250 1000 CONTINUE
251C at this point, CWORD must be 'SHOW'
252 CKIND = 'SHOW'
253 IF (KNAME .LE. 0) GO TO 1900
254 GO TO (1010,1020,1030,1040,1050,1060,1070,1070,1090,1100,
255 + 1110,1120,1130,1130,1150,1160,1170,1180,1190,1200,
256 + 1210,1220,1100,1100,1250,1900,1270,1270,1290,1300),KNAME
257C
258C . . . . . . . . . . show fcn
259 1010 CONTINUE
260 IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
261 CALL MNPRIN (0,AMIN)
262 GO TO 4000
263C . . . . . . . . . . show param
264 1020 CONTINUE
265 IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
266 CALL MNPRIN (5,AMIN)
267 GO TO 4000
268C . . . . . . . . . . show limits
269 1030 CONTINUE
270 IF (AMIN .EQ. UNDEFI) CALL MNAMIN(FCN,FUTIL)
271 CALL MNPRIN (1,AMIN)
272 GO TO 4000
273C . . . . . . . . . . show covar
274 1040 CALL MNMATU(1)
275 GO TO 4000
276C . . . . . . . . . . show corre
277 1050 CALL MNMATU(0)
278 GO TO 4000
279C . . . . . . . . . . show print
280 1060 CONTINUE
281 IF (ISW(5) .LT.-1) ISW(5) = -1
282 IF (ISW(5) .GT. 3) ISW(5) = 3
283 WRITE (ISYSWR,'(A)') ' ALLOWED PRINT LEVELS ARE:'
284 WRITE (ISYSWR,'(27X,A)') CPRLEV
285 WRITE (ISYSWR,1061) CPRLEV(ISW(5))
286 1061 FORMAT (/' CURRENT PRINTOUT LEVEL IS ',A)
287 GO TO 4000
288C . . . . . . . show nograd, grad
289 1070 CONTINUE
290 IF (ISW(3) .LE. 0) THEN
291 WRITE (ISYSWR, 1081)
292 1081 FORMAT(' NOGRAD IS SET. DERIVATIVES NOT COMPUTED IN FCN.')
293 ELSE
294 WRITE (ISYSWR, 1082)
295 1082 FORMAT(' GRAD IS SET. USER COMPUTES DERIVATIVES IN FCN.')
296 ENDIF
297 GO TO 4000
298C . . . . . . . . . . show errdef
299 1090 WRITE (ISYSWR, 1091) UP
300 1091 FORMAT (' ERRORS CORRESPOND TO FUNCTION CHANGE OF',G13.5)
301 GO TO 4000
302C . . . . . . . . . . show input,
303C batch, or interactive
304 1100 CONTINUE
305 INQUIRE(UNIT=ISYSRD,NAMED=LNAME,NAME=CFNAME)
306 CMODE = 'BATCH MODE '
307 IF (ISW(6) .EQ. 1) CMODE = 'INTERACTIVE MODE'
308 IF (.NOT. LNAME) CFNAME='unknown'
309 WRITE (ISYSWR,1002) CMODE,ISYSRD,CFNAME
310 1002 FORMAT (' INPUT NOW BEING READ IN ',A,' FROM UNIT NO.',I3/
311 + ' FILENAME: ',A)
312 GO TO 4000
313C . . . . . . . . . . show width
314 1110 WRITE (ISYSWR,1111) NPAGWD
315 1111 FORMAT (10X,'PAGE WIDTH IS SET TO',I4,' COLUMNS')
316 GO TO 4000
317C . . . . . . . . . . show lines
318 1120 WRITE (ISYSWR,1121) NPAGLN
319 1121 FORMAT (10X,'PAGE LENGTH IS SET TO',I4,' LINES')
320 GO TO 4000
321C . . . . . . .show nowarn, warn
322 1130 CONTINUE
323 CWARN = 'SUPPRESSED'
324 IF (LWARN) CWARN = 'REPORTED '
325 WRITE (ISYSWR,1141) CWARN
326 1141 FORMAT (' MINUIT WARNING MESSAGES ARE ',A)
327 IF (.NOT. LWARN) CALL MNWARN('W','SHO','SHO')
328 GO TO 4000
329C . . . . . . . . . . show random
330 1150 VAL = 0.
331 CALL MNRN15(VAL,IGRAIN)
332 IKSEED = IGRAIN
333 WRITE (ISYSWR, 1151) IKSEED
334 1151 FORMAT (' MINUIT RNDM SEED IS CURRENTLY=',I10/)
335 VAL = 3.0
336 ISEED = IKSEED
337 CALL MNRN15(VAL,ISEED)
338 GO TO 4000
339C . . . . . . . . . show title
340 1160 WRITE (ISYSWR,'(A,A)') ' TITLE OF CURRENT TASK IS:',CTITL
341 GO TO 4000
342C . . . . . . . show strategy
343 1170 WRITE (ISYSWR, '(A)') ' ALLOWED STRATEGIES ARE:'
344 WRITE (ISYSWR, '(20X,A)') CSTRAT
345 1172 WRITE (ISYSWR, 1175) CSTRAT(ISTRAT)
346 1175 FORMAT (/' NOW USING STRATEGY ',A/)
347 GO TO 4000
348C . . . . . show eigenvalues
349 1180 CONTINUE
350 ISWSAV = ISW(5)
351 ISW(5) = 3
352 IF (ISW(2) .LT. 1) THEN
353 WRITE (ISYSWR,'(1X,A)') COVMES(0)
354 ELSE
355 CALL MNPSDF
356 ENDIF
357 ISW(5) = ISWSAV
358 GO TO 4000
359C . . . . . show page throw
360 1190 WRITE (ISYSWR,'(A,I3)') ' PAGE THROW CARRIAGE CONTROL =',NEWPAG
361 IF (NEWPAG .EQ. 0)
362 + WRITE (ISYSWR,'(A)') ' NO PAGE THROWS IN MINUIT OUTPUT'
363 GO TO 4000
364C . . . . . . show minos errors
365 1200 CONTINUE
366 DO 1202 II= 1, NPAR
367 IF (ERP(II).GT.ZERO .OR. ERN(II).LT.ZERO) GO TO 1204
368 1202 CONTINUE
369 WRITE (ISYSWR,'(A)')
370 + ' THERE ARE NO MINOS ERRORS CURRENTLY VALID.'
371 GO TO 4000
372 1204 CONTINUE
373 CALL MNPRIN(4,AMIN)
374 GO TO 4000
375C . . . . . . . . . show epsmac
376 1210 WRITE (ISYSWR,'(A,E12.3)')
377 + ' FLOATING-POINT NUMBERS ASSUMED ACCURATE TO',EPSMAC
378 GO TO 4000
379C . . . . . . show outputfiles
380 1220 CONTINUE
381 WRITE (ISYSWR,'(A,I4)') ' MINUIT PRIMARY OUTPUT TO UNIT',ISYSWR
382 GO TO 4000
383C . . . . . . show version
384 1250 CONTINUE
385 WRITE (ISYSWR,'(A,A)') ' THIS IS MINUIT VERSION:',CVRSN
386 GO TO 4000
387C . . . . . . show nodebug, debug
388 1270 CONTINUE
389 DO 1285 ID= 0, NUMDBG
390 COPT = 'OFF'
391 IF (IDBG(ID) .GE. 1) COPT = 'ON '
392 1285 WRITE (ISYSWR,1286) ID, COPT, CDBOPT(ID)
393 1286 FORMAT (10X,'DEBUG OPTION',I3,' IS ',A3,' :',A)
394 IF (.NOT. LREPOR) CALL MNWARN('D','SHO','SHO')
395 GO TO 4000
396C . . . . . . . . . . show show
397 1290 CKIND = 'SHOW'
398 GO TO 2100
399C . . . . . . . . . . show set
400 1300 CKIND = 'SET '
401 GO TO 2100
402
403C -----------------------------------------------------
404C UNKNOWN COMMAND
405 1900 WRITE (ISYSWR, 1901) CWORD
406 1901 FORMAT (' THE COMMAND:',A10,' IS UNKNOWN.'/)
407 GO TO 2100
408C -----------------------------------------------------
409C HELP SHOW, HELP SET, SHOW SET, or SHOW SHOW
410 2000 CKIND = 'SET '
411 IF (INDEX(CWORD(4:10),'SHO') .GT. 0) CKIND = 'SHOW'
412 2100 WRITE (ISYSWR, 2101) CKIND,CKIND, (CNAME(KK),KK=1,NNAME)
413 2101 FORMAT (' THE FORMAT OF THE ',A4,' COMMAND IS:'//
414 + 1X,A4,' xxx [numerical arguments if any]'//
415 + ' WHERE xxx MAY BE ONE OF THE FOLLOWING:'/
416 + (7X,6A12))
417 GO TO 4000
418C -----------------------------------------------------
419C ILLEGAL COMMAND
420 3000 WRITE (ISYSWR,'('' ABOVE COMMAND IS ILLEGAL. IGNORED'')')
421 4000 RETURN
422 END
Note: See TracBrowser for help on using the repository browser.