COSMOS v7.655  COSMOSv7655
(AirShowerMC)
mnhelp.f
Go to the documentation of this file.
1 *
2 * $Id: mnhelp.F,v 1.2 1999/09/03 09:17:47 couet Exp $
3 *
4 * $Log: mnhelp.F,v $
5 * Revision 1.2 1999/09/03 09:17:47 couet
6 * - \Cind{} removed in the help of minuit. This was a Tex directive which very
7 * likely has been forgotten during a Tex to f77 translation. This didn't
8 * compile on RH6.
9 *
10 * Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
11 * Minuit
12 *
13 *
14  SUBROUTINE mnhelp(COMD,LOUT)
15 *.
16 *. HELP routine for MINUIT interactive commands.
17 *.
18 *. COMD ='* ' prints a global help for all commands
19 *. COMD =Command_name: print detailed help for one command.
20 *. Note that at least 3 characters must be given for the command name.
21 *.
22 *. Author: Rene Brun
23 * comments extracted from the MINUIT documentation file.
24 *.
25  CHARACTER*(*) COMD
26  CHARACTER*3 CMD3
27 *.
28 *-- command name ASSUMED to be in upper case
29 *__________________________________________________________________
30 *--
31 *-- Global HELP: Summary of all commands
32 *-- ====================================
33 *--
34  IF(comd(1:1) .EQ. '*')THEN
35  WRITE(lout,10000)
36  WRITE(lout,10001)
37  GO TO 99
38  ENDIF
39 10000 FORMAT(' ==>List of MINUIT Interactive commands:',/,
40  +' CLEar Reset all parameter names and values undefined',/,
41  +' CONtour Make contour map of the user function',/,
42  +' EXIT Exit from Interactive Minuit',/,
43  +' FIX Cause parameter(s) to remain constant',/,
44  +' HESse Calculate the Hessian or error matrix.',/,
45  +' IMPROVE Search for a new minimum around current minimum',/,
46  +' MIGrad Minimize by the method of Migrad',/,
47  +' MINImize MIGRAD + SIMPLEX method if Migrad fails',/,
48  +' MINOs Exact (non-linear) parameter error analysis')
49 10001 FORMAT(' MNContour Calculate one MINOS function contour',/,
50  +' PARameter Define or redefine new parameters and values',/,
51  +' RELease Make previously FIXed parameters variable again',/,
52  +' REStore Release last parameter fixed',/,
53  +' SAVe Save current parameter values on a file',/,
54  +' SCAn Scan the user function by varying parameters',/,
55  +' SEEk Minimize by the method of Monte Carlo',/,
56  +' SET Set various MINUIT constants or conditions',/,
57  +' SHOw Show values of current constants or conditions',/,
58  +' SIMplex Minimize by the method of Simplex')
59 *
60  cmd3=comd(1:3)
61 *__________________________________________________________________
62 *--
63 *-- Command CLEAR
64 *-- =============
65 *.
66  IF(cmd3.EQ.'CLE')THEN
67  WRITE(lout,10100)
68  GO TO 99
69  ENDIF
70 10100 FORMAT(' ***>CLEAR',/,
71  +' Resets all parameter names and values to undefined.',/,
72  +' Must normally be followed by a PARameters command or ',/,
73  +' equivalent, in order to define parameter values.')
74 *__________________________________________________________________
75 *--
76 *-- Command CONTOUR
77 *-- ===============
78 *.
79  IF(cmd3.EQ.'CON')THEN
80  WRITE(lout,10200)
81  GO TO 99
82  ENDIF
83 10200 FORMAT(' ***>CONTOUR <par1> <par2> [devs] [ngrid]',/,
84  +' Instructs Minuit to trace contour lines of the user function',/,
85  +' with respect to the two parameters whose external numbers',/,
86  +' are <par1> and <par2>.',/,
87  +' Other variable parameters of the function, if any, will have',/,
88  +' their values fixed at the current values during the contour',/,
89  +' tracing. The optional parameter [devs] (default value 2.)',/,
90  +' gives the number of standard deviations in each parameter',/,
91  +' which should lie entirely within the plotting area.',/,
92  +' Optional parameter [ngrid] (default value 25 unless page',/,
93  +' size is too small) determines the resolution of the plot,',/,
94  +' i.e. the number of rows and columns of the grid at which the',/,
95  +' function will be evaluated. [See also MNContour.]')
96 *__________________________________________________________________
97 *--
98 *-- Command END
99 *-- ===========
100 *.
101  IF(cmd3.EQ.'END')THEN
102  WRITE(lout,10300)
103  GO TO 99
104  ENDIF
105 10300 FORMAT(' ***>END',/,
106  +' Signals the end of a data block (i.e., the end of a fit),',/,
107  +' and implies that execution should continue, because another',/,
108  +' Data Block follows. A Data Block is a set of Minuit data',/,
109  +' consisting of',/,
110  +' (1) A Title,',/,
111  +' (2) One or more Parameter Definitions,',/,
112  +' (3) A blank line, and',/,
113  +' (4) A set of Minuit Commands.',/,
114  +' The END command is used when more than one Data Block is to',/,
115  +' be used with the same FCN function. It first causes Minuit',/,
116  +' to issue a CALL FCN with IFLAG=3, in order to allow FCN to',/,
117  +' perform any calculations associated with the final fitted',/,
118  +' parameter values, unless a CALL FCN 3 command has already',/,
119  +' been executed at the current FCN value.')
120 *__________________________________________________________________
121 *.
122 *--
123 *-- Command EXIT
124 *-- ============
125  IF(cmd3 .EQ.'EXI')THEN
126  WRITE(lout,10400)
127  GO TO 99
128  ENDIF
129 10400 FORMAT(' ***>EXIT',/,
130  +' Signals the end of execution.',/,
131  +' The EXIT command first causes Minuit to issue a CALL FCN',/,
132  +' with IFLAG=3, to allow FCN to perform any calculations',/,
133  +' associated with the final fitted parameter values, unless a',/,
134  +' CALL FCN 3 command has already been executed.')
135 *__________________________________________________________________
136 *--
137 *-- Command FIX
138 *-- ===========
139 *.
140  IF(cmd3.EQ.'FIX')THEN
141  WRITE(lout,10500)
142  GO TO 99
143  ENDIF
144 10500 FORMAT(' ***>FIX} <parno> [parno] ... [parno]',/,
145  +' Causes parameter(s) <parno> to be removed from the list of',/,
146  +' variable parameters, and their value(s) will remain constant',/,
147  +' during subsequent minimizations, etc., until another command',/,
148  +' changes their value(s) or status.')
149 *__________________________________________________________________
150 *--
151 *-- Command HESSE
152 *-- =============
153 *.
154  IF(cmd3.EQ.'HES')THEN
155  WRITE(lout,10600)
156  GO TO 99
157  ENDIF
158 10600 FORMAT(' ***>HESse [maxcalls]',/,
159  +' Calculate, by finite differences, the Hessian or error matrix.',
160  +/,' That is, it calculates the full matrix of second derivatives'
161  +,/,' of the function with respect to the currently variable',/,
162  +' parameters, and inverts it, printing out the resulting error',/,
163  +' matrix. The optional argument [maxcalls] specifies the',/,
164  +' (approximate) maximum number of function calls after which',/,
165  +' the calculation will be stopped.')
166 *__________________________________________________________________
167 *--
168 *-- Command IMPROVE
169 *-- ===============
170 *.
171  IF(cmd3.EQ.'IMP')THEN
172  WRITE(lout,10700)
173  GO TO 99
174  ENDIF
175 10700 FORMAT(' ***>IMPROVE [maxcalls]',/,
176  +' If a previous minimization has converged, and the current',/,
177  +' values of the parameters therefore correspond to a local',/,
178  +' minimum of the function, this command requests a search for',/,
179  +' additional distinct local minima.',/,
180  +' The optional argument [maxcalls] specifies the (approximate)',/,
181  +' maximum number of function calls after which the calculation',/,
182  +' will be stopped.')
183 *__________________________________________________________________
184 *--
185 *-- Command MIGRAD
186 *-- ==============
187 *.
188  IF(cmd3.EQ.'MIG')THEN
189  WRITE(lout,10800)
190  GO TO 99
191  ENDIF
192 10800 FORMAT(' ***>MIGrad [maxcalls] [tolerance]',/,
193  +' Causes minimization of the function by the method of Migrad,',/,
194  +' the most efficient and complete single method, recommended',/,
195  +' for general functions (see also MINImize).',/,
196  +' The minimization produces as a by-product the error matrix',/,
197  +' of the parameters, which is usually reliable unless warning',/,
198  +' messages are produced.',/,
199  +' The optional argument [maxcalls] specifies the (approximate)',/,
200  +' maximum number of function calls after which the calculation',/,
201  +' will be stopped even if it has not yet converged.',/,
202  +' The optional argument [tolerance] specifies required tolerance',
203  +/,' on the function value at the minimum.',/,
204  +' The default tolerance is 0.1, and the minimization will stop',/,
205  +' when the estimated vertical distance to the minimum (EDM) is',/,
206  +' less than 0.001*[tolerance]*UP (see [SET ERRordef]).')
207 *__________________________________________________________________
208 *--
209 *-- Command MINIMIZE
210 *-- ================
211 *.
212  IF(comd(1:4).EQ.'MINI')THEN
213  WRITE(lout,10900)
214  GO TO 99
215  ENDIF
216 10900 FORMAT(' ***>MINImize [maxcalls] [tolerance]',/,
217  +' Causes minimization of the function by the method of Migrad,',/,
218  +' as does the MIGrad command, but switches to the SIMplex method',
219  +/,' if Migrad fails to converge. Arguments are as for MIGrad.',/,
220  +' Note that command requires four characters to be unambiguous.')
221 *__________________________________________________________________
222 *--
223 *-- Command MINOS
224 *-- =============
225 *.
226  IF(comd(1:4).EQ.'MINO')THEN
227  WRITE(lout,11000)
228  GO TO 99
229  ENDIF
230 11000 FORMAT(' ***>MINOs [maxcalls] [parno] [parno] ...',/,
231  +' Causes a Minos error analysis to be performed on the parameters'
232  +,/,' whose numbers [parno] are specified. If none are specified,',
233  +/,' Minos errors are calculated for all variable parameters.',/,
234  +' Minos errors may be expensive to calculate, but are very',/,
235  +' reliable since they take account of non-linearities in the',/,
236  +' problem as well as parameter correlations, and are in general',/
237  +' asymmetric.',/,
238  +' The optional argument [maxcalls] specifies the (approximate)',/,
239  +' maximum number of function calls per parameter requested,',/,
240  +' after which the calculation will stop for that parameter.')
241 *__________________________________________________________________
242 *--
243 *-- Command MNCONTOUR
244 *-- =================
245 *.
246  IF(cmd3.EQ.'MNC')THEN
247  WRITE(lout,11100)
248  GO TO 99
249  ENDIF
250 11100 FORMAT(' ***>MNContour <par1> <par2> [npts]',/,
251  +' Calculates one function contour of FCN with respect to',/,
252  +' parameters par1 and par2, with FCN minimized always with',/,
253  +' respect to all other NPAR-2 variable parameters (if any).',/,
254  +' Minuit will try to find npts points on the contour (default 20)'
255  +,/,' If only two parameters are variable at the time, it is not',
256  +/,' necessary to specify their numbers. To calculate more than',/,
257  +' one contour, it is necessary to SET ERRordef to the appropriate'
258  +,/,' value and issue the MNContour command for each contour.')
259 *__________________________________________________________________
260 *--
261 *-- Command PARAMETER
262 *-- =================
263 *.
264  IF(cmd3.EQ.'PAR')THEN
265  WRITE(lout,11150)
266  GO TO 99
267  ENDIF
268 11150 FORMAT(' ***>PARameters',/,
269  +' followed by one or more parameter definitions.',/,
270  +' Parameter definitions are of the form:',/,
271  +' <number> ''name'' <value> <step> [lolim] [uplim] ',/,
272  +' for example:',/,
273  +' 3 ''K width'' 1.2 0.1' ,/,
274  +' the last definition is followed by a blank line or a zero.')
275 *__________________________________________________________________
276 *--
277 *-- Command RELEASE
278 *-- ===============
279 *.
280  IF(cmd3.EQ.'REL')THEN
281  WRITE(lout,11200)
282  GO TO 99
283  ENDIF
284 11200 FORMAT(' ***>RELease <parno> [parno] ... [parno]',/,
285  +' If <parno> is the number of a previously variable parameter',/,
286  +' which has been fixed by a command: FIX <parno>, then that',/,
287  +' parameter will return to variable status. Otherwise a warning'
288  +,/,' message is printed and the command is ignored.',/,
289  +' Note that this command operates only on parameters which were',/
290  +' at one time variable and have been FIXed. It cannot make',/,
291  +' constant parameters variable; that must be done by redefining',/
292  +' the parameter with a PARameters command.')
293 *__________________________________________________________________
294 *--
295 *-- Command RESTORE
296 *-- ===============
297 *.
298  IF(cmd3.EQ.'RES')THEN
299  WRITE(lout,11300)
300  GO TO 99
301  ENDIF
302 11300 FORMAT(' ***>REStore [code]',/,
303  +' If no [code] is specified, this command restores all previously'
304  +,/,' FIXed parameters to variable status. If [code]=1, then only',
305  +/,' the last parameter FIXed is restored to variable status.',/,
306  +' If code is neither zero nor one, the command is ignored.')
307 *__________________________________________________________________
308 *--
309 *-- Command RETURN
310 *-- ==============
311 *.
312  IF(cmd3.EQ.'RET')THEN
313  WRITE(lout,11400)
314  GO TO 99
315  ENDIF
316 11400 FORMAT(' ***>RETURN',/,
317  +' Signals the end of a data block, and instructs Minuit to return'
318  +,/,' to the program which called it. The RETurn command first',/,
319  +' causes Minuit to CALL FCN with IFLAG=3, in order to allow FCN',/
320  +,' to perform any calculations associated with the final fitted',/
321  +,' parameter values, unless a CALL FCN 3 command has already been'
322  +,/,' executed at the current FCN value.')
323 *__________________________________________________________________
324 *--
325 *-- Command SAVE
326 *-- ============
327 *.
328  IF(cmd3.EQ.'SAV')THEN
329  WRITE(lout,11500)
330  GO TO 99
331  ENDIF
332 11500 FORMAT(' ***>SAVe',/,
333  +' Causes the current parameter values to be saved on a file in',/,
334  +' such a format that they can be read in again as Minuit',/,
335  +' parameter definitions. If the covariance matrix exists, it is',/
336  +,' also output in such a format. The unit number is by default 7,'
337  +,/,' or that specified by the user in his call to MINTIO or',/,
338  +' MNINIT. The user is responsible for opening the file previous'
339  +,/,' to issuing the [SAVe] command (except where this can be done'
340  +,/,' interactively).')
341 *__________________________________________________________________
342 *--
343 *-- Command SCAN
344 *-- ============
345 *.
346  IF(cmd3.EQ.'SCA')THEN
347  WRITE(lout,11600)
348  GO TO 99
349  ENDIF
350 11600 FORMAT(' ***>SCAn [parno] [numpts] [from] [to]',/,
351  +' Scans the value of the user function by varying parameter',/,
352  +' number [parno], leaving all other parameters fixed at the',/,
353  +' current value. If [parno] is not specified, all variable',/,
354  +' parameters are scanned in sequence.',/,
355  +' The number of points [numpts] in the scan is 40 by default,',/,
356  +' and cannot exceed 100. The range of the scan is by default',/,
357  +' 2 standard deviations on each side of the current best value,',
358  +/,' but can be specified as from [from] to [to].',/,
359  +' After each scan, if a new minimum is found, the best parameter'
360  +,/,' values are retained as start values for future scans or',/,
361  +' minimizations. The curve resulting from each scan is plotted',/
362  +,' on the output unit in order to show the approximate behaviour'
363  +,/,' of the function.',/,
364  +' This command is not intended for minimization, but is sometimes'
365  +,/,' useful for debugging the user function or finding a',/,
366  +' reasonable starting point.')
367 *__________________________________________________________________
368 *--
369 *-- Command SEEK
370 *-- ============
371 *.
372  IF(cmd3.EQ.'SEE')THEN
373  WRITE(lout,11700)
374  GO TO 99
375  ENDIF
376 11700 FORMAT(' ***>SEEk [maxcalls] [devs]',/,
377  +' Causes a Monte Carlo minimization of the function, by choosing',
378  +/,' random values of the variable parameters, chosen uniformly',/,
379  +' over a hypercube centered at the current best value.',/,
380  +' The region size is by default 3 standard deviations on each',/,
381  +' side, but can be changed by specifying the value of [devs].')
382 *__________________________________________________________________
383 *--
384 *-- Command SET
385 *-- ===========
386 *.
387  IF(cmd3.EQ.'SET')THEN
388  WRITE(lout,11800)
389  WRITE(lout,11801)
390  WRITE(lout,11802)
391  WRITE(lout,11803)
392  WRITE(lout,11804)
393  WRITE(lout,11805)
394  WRITE(lout,11806)
395  WRITE(lout,11807)
396  WRITE(lout,11808)
397  WRITE(lout,11809)
398  WRITE(lout,11810)
399  WRITE(lout,11811)
400  WRITE(lout,11812)
401  WRITE(lout,11813)
402  WRITE(lout,11814)
403  WRITE(lout,11815)
404  WRITE(lout,11816)
405  WRITE(lout,11817)
406  GO TO 99
407  ENDIF
408 11800 FORMAT(' ***>SET <option_name>',/,/,
409  +' SET BATch',/,
410  +' Informs Minuit that it is running in batch mode.',//,
411  +' SET EPSmachine <accuracy>',/,
412  +' Informs Minuit that the relative floating point arithmetic',/
413  +' precision is <accuracy>. Minuit determines the nominal',/,
414  +' precision itself, but the SET EPSmachine command can be',/,
415  +' used to override Minuit own determination, when the user',/,
416  +' knows that the FCN function value is not calculated to',/,
417  +' the nominal machine accuracy. Typical values of <accuracy>',/
418  +' are between 10**-5 and 10**-14.')
419 11801 FORMAT(/,' SET ERRordef <up>',/,
420  +' Sets the value of UP (default value= 1.), defining parameter'
421  +,/,' errors. Minuit defines parameter errors as the change',/,
422  +' in parameter value required to change the function value',/,
423  +' by UP. Normally, for chisquared fits UP=1, and for negative'
424  +,/,' log likelihood, UP=0.5.')
425 11802 FORMAT(/,' SET GRAdient [force]',/,
426  +' Informs Minuit that the user function is prepared to',/,
427  +' calculate its own first derivatives and return their values'
428  +,/,' in the array GRAD when IFLAG=2 (see specs of FCN).',/,
429  +' If [force] is not specified, Minuit will calculate',/,
430  +' the FCN derivatives by finite differences at the current',/,
431  +' point and compare with the user calculation at that point,'
432  +,/,' accepting the user values only if they agree.',/,
433  +' If [force]=1, Minuit does not do its own derivative',/,
434  +' calculation, and uses the derivatives calculated in FCN.')
435 11803 FORMAT(/,' SET INPut [unitno] [filename]',/,
436  +' Causes Minuit, in data-driven mode only, to read subsequent',
437  +/,' commands (or parameter definitions) from a different input'
438  +,/,' file. If no [unitno] is specified, reading reverts to the'
439  +,/,' previous input file, assuming that there was one.',/,
440  +' If [unitno] is specified, and that unit has not been opened,'
441  +,/,' then Minuit attempts to open the file [filename]} if a',/,
442  +' name is specified. If running in interactive mode and',/,
443  +' [filename] is not specified and [unitno] is not opened,',/,
444  +' Minuit prompts the user to enter a file name.',/,
445  +' If the word REWIND is added to the command (note:no blanks',/
446  +' between INPUT and REWIND), the file is rewound before',/,
447  +' reading. Note that this command is implemented in standard',/
448  +' Fortran 77 and the results may depend on the system;',/,
449  +' for example, if a filename is given under VM/CMS, it must',/,
450  +' be preceeded by a slash.')
451 11804 FORMAT(/,' SET INTeractive',/,
452  +' Informs Minuit that it is running interactively.')
453 11805 FORMAT(/,' SET LIMits [parno] [lolim] [uplim]',/,
454  +' Allows the user to change the limits on one or all',/,
455  +' parameters. If no arguments are specified, all limits are',/,
456  +' removed from all parameters. If [parno] alone is specified,',
457  +/,' limits are removed from parameter [parno].',/,
458  +' If all arguments are specified, then parameter [parno] will',
459  +/,' be bounded between [lolim] and [uplim].',/,
460  +' Limits can be specified in either order, Minuit will take',/,
461  +' the smaller as [lolim] and the larger as [uplim].',/,
462  +' However, if [lolim] is equal to [uplim], an error condition',
463  +/,' results.')
464 11806 FORMAT(/,' SET LINesperpage',/,
465  +' Sets the number of lines for one page of output.',/,
466  +' Default value is 24 for interactive mode')
467 11807 FORMAT(/,' SET NOGradient',/,
468  +' The inverse of SET GRAdient, instructs Minuit not to',
469  +/,' use the first derivatives calculated by the user in FCN.')
470 11808 FORMAT(/,' SET NOWarnings',/,
471  +' Supresses Minuit warning messages.')
472 11809 FORMAT(/,' SET OUTputfile <unitno>',/,
473  +' Instructs Minuit to write further output to unit <unitno>.')
474 11810 FORMAT(/,' SET PAGethrow <integer>',/,
475  +' Sets the carriage control character for ``new page'' to',/,
476  +' <integer>. Thus the value 1 produces a new page, and 0',/,
477  +' produces a blank line, on some devices (see TOPofpage)')
478 11811 FORMAT(/,' SET PARameter <parno> <value>',/,
479  +' Sets the value of parameter <parno> to <value>.',/,
480  +' The parameter in question may be variable, fixed, or',/,
481  +' constant, but must be defined.')
482 11812 FORMAT(/,' SET PRIntout <level>',/,
483  +' Sets the print level, determining how much output will be',/,
484  +' produced. Allowed values and their meanings are displayed',/,
485  +' after a SHOw PRInt command, and are currently <level>=:',/,
486  +' [-1] no output except from SHOW commands',/,
487  +' [0] minimum output',/,
488  +' [1] default value, normal output',/,
489  +' [2] additional output giving intermediate results.',/,
490  +' [3] maximum output, showing progress of minimizations.',/
491  +' Note: See also the SET WARnings command.')
492 11813 FORMAT(/,' SET RANdomgenerator <seed>',/,
493  +' Sets the seed of the random number generator used in SEEk.',/
494  +' This can be any integer between 10000 and 900000000, for',/,
495  +' example one which was output from a SHOw RANdom command of',/
496  +' a previous run.')
497 11814 FORMAT(/,' SET STRategy <level>',/,
498  +' Sets the strategy to be used in calculating first and second'
499  +,/,' derivatives and in certain minimization methods.',/,
500  +' In general, low values of <level> mean fewer function calls',
501  +/,' and high values mean more reliable minimization.',/,
502  +' Currently allowed values are 0, 1 (default), and 2.')
503 11815 FORMAT(/,' SET TITle',/,
504  +' Informs Minuit that the next input line is to be considered',
505  +/,' the (new) title for this task or sub-task. This is for',/,
506  +' the convenience of the user in reading his output.')
507 11816 FORMAT(/,' SET WARnings',/,
508  +' Instructs Minuit to output warning messages when suspicious',
509  +/,' conditions arise which may indicate unreliable results.',/
510  +' This is the default.')
511 11817 FORMAT(/,' SET WIDthpage',/,
512  +' Informs Minuit of the output page width.',/,
513  +' Default values are 80 for interactive jobs')
514 *__________________________________________________________________
515 *--
516 *-- Command SHOW
517 *-- ============
518 *.
519  IF(cmd3.EQ.'SHO')THEN
520  WRITE(lout,11900)
521  WRITE(lout,11901)
522  WRITE(lout,11902)
523  WRITE(lout,11903)
524  WRITE(lout,11904)
525  GO TO 99
526  ENDIF
527 11900 FORMAT(' ***>SHOw <option_name>',/,
528  +' All SET XXXX commands have a corresponding SHOw XXXX command.',
529  +/,' In addition, the SHOw commands listed starting here have no',
530  +/,' corresponding SET command for obvious reasons.')
531 11901 FORMAT(/,' SHOw CORrelations',/,
532  +' Calculates and prints the parameter correlations from the',/,
533  +' error matrix.')
534 11902 FORMAT(/,' SHOw COVariance',/,
535  +' Prints the (external) covariance (error) matrix.')
536 11903 FORMAT(/,' SHOw EIGenvalues',/,
537  +' Calculates and prints the eigenvalues of the covariance',/,
538  +' matrix.')
539 11904 FORMAT(/,' SHOw FCNvalue',/,
540  +' Prints the current value of FCN.')
541 *__________________________________________________________________
542 *--
543 *-- Command SIMPLEX
544 *-- ===============
545 *.
546  IF(cmd3.EQ.'SIM')THEN
547  WRITE(lout,12000)
548  GO TO 99
549  ENDIF
550 12000 FORMAT(' ***>SIMplex [maxcalls] [tolerance]',/,
551  +' Performs a function minimization using the simplex method of',/
552  +' Nelder and Mead. Minimization terminates either when the',/,
553  +' function has been called (approximately) [maxcalls] times,',/,
554  +' or when the estimated vertical distance to minimum (EDM) is',/,
555  +' less than [tolerance].',/,
556  +' The default value of [tolerance] is 0.1*UP(see SET ERRordef).')
557 *__________________________________________________________________
558 *--
559 *-- Command STANDARD
560 *-- ================
561 *.
562  IF(cmd3.EQ.'STA')THEN
563  WRITE(lout,12100)
564  GO TO 99
565  ENDIF
566 12100 FORMAT(' ***>STAndard',/,
567  +' Causes Minuit to execute the Fortran instruction CALL STAND',/,
568  +' where STAND is a subroutine supplied by the user.')
569 *__________________________________________________________________
570 *--
571 *-- Command STOP
572 *-- ============
573 *.
574  IF(cmd3.EQ.'STO')THEN
575  WRITE(lout,12200)
576  GO TO 99
577  ENDIF
578 12200 FORMAT(' ***>STOP',/,
579  +' Same as EXIT.')
580 *__________________________________________________________________
581 *--
582 *-- Command TOPOFPAGE
583 *-- =================
584 *.
585  IF(cmd3.EQ.'TOP')THEN
586  WRITE(lout,12300)
587  GO TO 99
588  ENDIF
589 12300 FORMAT(' ***>TOPofpage',/,
590  +' Causes Minuit to write the character specified in a',/,
591  +' SET PAGethrow command (default = 1) to column 1 of the output'
592  +,/,' file, which may or may not position your output medium to',
593  +/,' the top of a page depending on the device and system.')
594 *__________________________________________________________________
595 *
596  WRITE(lout,13000)
597 13000 FORMAT(' Unknown MINUIT command. Type HELP for list of commands.')
598 *
599  99 RETURN
600  END
subroutine mnhelp(COMD, LOUT)
Definition: mnhelp.f:15