| 1 | * | 
|---|
| 2 | * $Id: mninit.F,v 1.1.1.1 2003-06-11 14:18:28 cmv Exp $ | 
|---|
| 3 | * | 
|---|
| 4 | * $Log: not supported by cvs2svn $ | 
|---|
| 5 | * Revision 1.4  1997/09/02 15:16:08  mclareni | 
|---|
| 6 | * WINNT corrections | 
|---|
| 7 | * | 
|---|
| 8 | * Revision 1.3  1997/03/14 17:18:00  mclareni | 
|---|
| 9 | * WNT mods | 
|---|
| 10 | * | 
|---|
| 11 | * Revision 1.2.2.1  1997/01/21 11:33:28  mclareni | 
|---|
| 12 | * All mods for Winnt 96a on winnt branch | 
|---|
| 13 | * | 
|---|
| 14 | * Revision 1.2  1996/03/15 18:02:47  james | 
|---|
| 15 | *     Modified Files: | 
|---|
| 16 | * mnderi.F eliminate possible division by zero | 
|---|
| 17 | * mnexcm.F suppress print on STOP when print flag=-1 | 
|---|
| 18 | *          set FVAL3 to flag if FCN already called with IFLAG=3 | 
|---|
| 19 | * mninit.F set version 96.03 | 
|---|
| 20 | * mnlims.F remove arguments, not needed | 
|---|
| 21 | * mnmigr.F VLEN -> LENV in debug print statement | 
|---|
| 22 | * mnparm.F move call to MNRSET to after NPAR redefined, to zero all | 
|---|
| 23 | * mnpsdf.F eliminate possible division by zero | 
|---|
| 24 | * mnscan.F suppress printout when print flag =-1 | 
|---|
| 25 | * mnset.F  remove arguments in call to MNLIMS | 
|---|
| 26 | * mnsimp.F fix CSTATU so status is PROGRESS only if new minimum | 
|---|
| 27 | * mnvert.F eliminate possible division by zero | 
|---|
| 28 | * | 
|---|
| 29 | * Revision 1.1.1.1  1996/03/07 14:31:30  mclareni | 
|---|
| 30 | * Minuit | 
|---|
| 31 | * | 
|---|
| 32 | * | 
|---|
| 33 | #include "minuit/pilot.h" | 
|---|
| 34 | SUBROUTINE MNINIT (I1,I2,I3) | 
|---|
| 35 | #include "minuit/d506dp.inc" | 
|---|
| 36 | CC        This is the main initialization subroutine for MINUIT | 
|---|
| 37 | CC     It initializes some constants in common | 
|---|
| 38 | CC                (including the logical I/O unit nos.), | 
|---|
| 39 | CC | 
|---|
| 40 | #include "minuit/d506cm.inc" | 
|---|
| 41 | C | 
|---|
| 42 | CCC_CMV      EXTERNAL INTRAC | 
|---|
| 43 | CCC_CMV      LOGICAL  INTRAC | 
|---|
| 44 | C            I/O unit numbers | 
|---|
| 45 | ISYSRD = I1 | 
|---|
| 46 | ISYSWR = I2 | 
|---|
| 47 | ISTKWR(1) = ISYSWR | 
|---|
| 48 | NSTKWR = 1 | 
|---|
| 49 | ISYSSA = I3 | 
|---|
| 50 | NSTKRD = 0 | 
|---|
| 51 | C               version identifier | 
|---|
| 52 | CVRSN = '96.03 ' | 
|---|
| 53 | C               some CONSTANT constants in COMMON | 
|---|
| 54 | MAXINT=MNI | 
|---|
| 55 | MAXEXT=MNE | 
|---|
| 56 | UNDEFI = -54321. | 
|---|
| 57 | BIGEDM = 123456. | 
|---|
| 58 | CUNDEF = ')UNDEFINED' | 
|---|
| 59 | COVMES(0) = 'NO ERROR MATRIX       ' | 
|---|
| 60 | COVMES(1) = 'ERR MATRIX APPROXIMATE' | 
|---|
| 61 | COVMES(2) = 'ERR MATRIX NOT POS-DEF' | 
|---|
| 62 | COVMES(3) = 'ERROR MATRIX ACCURATE ' | 
|---|
| 63 | C                some starting values in COMMON | 
|---|
| 64 | NBLOCK = 0 | 
|---|
| 65 | ICOMND = 0 | 
|---|
| 66 | CTITL = CUNDEF | 
|---|
| 67 | CFROM = 'INPUT   ' | 
|---|
| 68 | NFCNFR = NFCN | 
|---|
| 69 | CSTATU= 'INITIALIZE' | 
|---|
| 70 | ISW(3) = 0 | 
|---|
| 71 | ISW(4) = 0 | 
|---|
| 72 | ISW(5) = 1 | 
|---|
| 73 | C         ISW(6)=0 for batch jobs,  =1 for interactive jobs | 
|---|
| 74 | C                      =-1 for originally interactive temporarily batch | 
|---|
| 75 | ISW(6) = 0 | 
|---|
| 76 | #ifndef CERNLIB_MSSTDCALL | 
|---|
| 77 | CCC_CMV      IF (INTRAC(DUMMY))  ISW(6) = 1 | 
|---|
| 78 | #else | 
|---|
| 79 | CCC_CMV      IF (INTRAC())  ISW(6) = 1 | 
|---|
| 80 | #endif | 
|---|
| 81 | C        DEBUG options set to default values | 
|---|
| 82 | DO 10 IDB= 0, MAXDBG | 
|---|
| 83 | 10 IDBG(IDB) = 0 | 
|---|
| 84 | LREPOR = .FALSE. | 
|---|
| 85 | LWARN  = .TRUE. | 
|---|
| 86 | LIMSET = .FALSE. | 
|---|
| 87 | LNEWMN = .FALSE. | 
|---|
| 88 | ISTRAT = 1 | 
|---|
| 89 | ITAUR = 0 | 
|---|
| 90 | C        default page dimensions and 'new page' carriage control integer | 
|---|
| 91 | NPAGWD = 120 | 
|---|
| 92 | NPAGLN = 56 | 
|---|
| 93 | NEWPAG = 1 | 
|---|
| 94 | IF (ISW(6) .GT. 0) THEN | 
|---|
| 95 | NPAGWD = 80 | 
|---|
| 96 | NPAGLN = 30 | 
|---|
| 97 | NEWPAG = 0 | 
|---|
| 98 | ENDIF | 
|---|
| 99 | UP = 1.0 | 
|---|
| 100 | UPDFLT = UP | 
|---|
| 101 | C                   determine machine accuracy epsmac | 
|---|
| 102 | EPSTRY = 0.5 | 
|---|
| 103 | DO 33 I= 1, 100 | 
|---|
| 104 | EPSTRY = EPSTRY * 0.5 | 
|---|
| 105 | EPSP1 = ONE + EPSTRY | 
|---|
| 106 | CALL MNTINY(EPSP1, EPSBAK) | 
|---|
| 107 | IF (EPSBAK .LT. EPSTRY)  GO TO 35 | 
|---|
| 108 | 33 CONTINUE | 
|---|
| 109 | EPSTRY = 1.0E-7 | 
|---|
| 110 | EPSMAC = 4.0*EPSTRY | 
|---|
| 111 | WRITE (ISYSWR,'(A,A,E10.2)') ' MNINIT UNABLE TO DETERMINE', | 
|---|
| 112 | + ' ARITHMETIC PRECISION. WILL ASSUME:',EPSMAC | 
|---|
| 113 | 35 EPSMAC = 8.0 * EPSTRY | 
|---|
| 114 | EPSMA2 = 2.0 * SQRT(EPSMAC) | 
|---|
| 115 | C                 the vlims are a non-negligible distance from pi/2 | 
|---|
| 116 | C         used by MNPINT to set variables "near" the physical limits | 
|---|
| 117 | PIBY2 = 2.0*ATAN(1.0) | 
|---|
| 118 | DISTNN = 8.0*SQRT(EPSMA2) | 
|---|
| 119 | VLIMHI =  PIBY2 - DISTNN | 
|---|
| 120 | VLIMLO = -PIBY2 + DISTNN | 
|---|
| 121 | CALL MNCLER | 
|---|
| 122 | WRITE (ISYSWR,'(3A,I3,A,I3,A,E10.2)')  '  MINUIT RELEASE ',CVRSN, | 
|---|
| 123 | +' INITIALIZED.   DIMENSIONS ',MNE,'/',MNI,'  EPSMAC=',EPSMAC | 
|---|
| 124 | RETURN | 
|---|
| 125 | END | 
|---|