source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnprin.F@ 3632

Last change on this file since 3632 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: 6.4 KB
RevLine 
[2403]1*
2* $Id: mnprin.F,v 1.1.1.1 2003-06-11 14:18:29 cmv Exp $
3*
4* $Log: not supported by cvs2svn $
5* Revision 1.1.1.1 1996/03/07 14:31:31 mclareni
6* Minuit
7*
8*
9#include "minuit/pilot.h"
10 SUBROUTINE MNPRIN (INKODE,FVAL)
11#include "minuit/d506dp.inc"
12CC Prints the values of the parameters at the time of the call.
13CC also prints other relevant information such as function value,
14CC estimated distance to minimum, parameter errors, step sizes.
15CC
16C According to the value of IKODE, the printout is:
17C IKODE=INKODE= 0 only info about function value
18C 1 parameter values, errors, limits
19C 2 values, errors, step sizes, internal values
20C 3 values, errors, step sizes, first derivs.
21C 4 values, parabolic errors, MINOS errors
22C when INKODE=5, MNPRIN chooses IKODE=1,2, or 3, according to ISW(2)
23C
24#include "minuit/d506cm.inc"
25C
26 CHARACTER*14 COLHDU(6),COLHDL(6), CX2,CX3,CGETX
27 CHARACTER*11 CNAMBF, CBLANK
28 CHARACTER CHEDM*10, CHEVAL*15
29 PARAMETER (CGETX='PLEASE GET X..')
30 DATA CBLANK/' '/
31C
32 IF (NU .EQ. 0) THEN
33 WRITE (ISYSWR,'(A)') ' THERE ARE CURRENTLY NO PARAMETERS DEFINED'
34 GO TO 700
35 ENDIF
36C get value of IKODE based in INKODE, ISW(2)
37 IKODE = INKODE
38 IF (INKODE .EQ. 5) THEN
39 IKODE = ISW(2)+1
40 IF (IKODE .GT. 3) IKODE=3
41 ENDIF
42C set 'default' column headings
43 DO 5 K= 1, 6
44 COLHDU(K) = 'UNDEFINED'
45 5 COLHDL(K) = 'COLUMN HEAD'
46C print title if Minos errors, and title exists.
47 IF (IKODE.EQ.4 .AND. CTITL.NE.CUNDEF)
48 + WRITE (ISYSWR,'(/A,A)') ' MINUIT TASK: ',CTITL
49C report function value and status
50 IF (FVAL .EQ. UNDEFI) THEN
51 CHEVAL = ' unknown '
52 ELSE
53 WRITE (CHEVAL,'(G15.7)') FVAL
54 ENDIF
55 IF (EDM .EQ. BIGEDM) THEN
56 CHEDM = ' unknown '
57 ELSE
58 WRITE (CHEDM, '(E10.2)') EDM
59 ENDIF
60 NC = NFCN-NFCNFR
61 WRITE (ISYSWR,905) CHEVAL,CFROM,CSTATU,NC,NFCN
62 905 FORMAT (/' FCN=',A,' FROM ',A8,' STATUS=',A10,I6,' CALLS',
63 + I9,' TOTAL')
64 M = ISW(2)
65 IF (M.EQ.0 .OR. M.EQ.2 .OR. DCOVAR.EQ.ZERO) THEN
66 WRITE (ISYSWR,907) CHEDM,ISTRAT,COVMES(M)
67 907 FORMAT (21X,'EDM=',A,' STRATEGY=',I2,6X,A)
68 ELSE
69 DCMAX = 1.
70 DC = MIN(DCOVAR,DCMAX) * 100.
71 WRITE (ISYSWR,908) CHEDM,ISTRAT,DC
72 908 FORMAT (21X,'EDM=',A,' STRATEGY=',I1,' ERROR MATRIX',
73 + ' UNCERTAINTY=',F5.1,'%')
74 ENDIF
75C
76 IF (IKODE .EQ. 0) GO TO 700
77C find longest name (for Rene!)
78 NTRAIL = 10
79 DO 20 I= 1, NU
80 IF (NVARL(I) .LT. 0) GO TO 20
81 DO 15 IC= 10,1,-1
82 IF (CPNAM(I)(IC:IC) .NE. ' ') GO TO 16
83 15 CONTINUE
84 IC = 1
85 16 LBL = 10-IC
86 IF (LBL .LT. NTRAIL) NTRAIL=LBL
87 20 CONTINUE
88 NADD = NTRAIL/2 + 1
89 IF (IKODE .EQ. 1) THEN
90 COLHDU(1) = ' '
91 COLHDL(1) = ' ERROR '
92 COLHDU(2) = ' PHYSICAL'
93 COLHDU(3) = ' LIMITS '
94 COLHDL(2) = ' NEGATIVE '
95 COLHDL(3) = ' POSITIVE '
96 ENDIF
97 IF (IKODE .EQ. 2) THEN
98 COLHDU(1) = ' '
99 COLHDL(1) = ' ERROR '
100 COLHDU(2) = ' INTERNAL '
101 COLHDL(2) = ' STEP SIZE '
102 COLHDU(3) = ' INTERNAL '
103 COLHDL(3) = ' VALUE '
104 ENDIF
105 IF (IKODE .EQ. 3) THEN
106 COLHDU(1) = ' '
107 COLHDL(1) = ' ERROR '
108 COLHDU(2) = ' STEP '
109 COLHDL(2) = ' SIZE '
110 COLHDU(3) = ' FIRST '
111 COLHDL(3) = ' DERIVATIVE '
112 ENDIF
113 IF (IKODE .EQ. 4) THEN
114 COLHDU(1) = ' PARABOLIC '
115 COLHDL(1) = ' ERROR '
116 COLHDU(2) = ' MINOS '
117 COLHDU(3) = 'ERRORS '
118 COLHDL(2) = ' NEGATIVE '
119 COLHDL(3) = ' POSITIVE '
120 ENDIF
121C
122 IF (IKODE .NE. 4) THEN
123 IF (ISW(2) .LT. 3) COLHDU(1)=' APPROXIMATE '
124 IF (ISW(2) .LT. 1) COLHDU(1)=' CURRENT GUESS'
125 ENDIF
126 NCOL = 3
127 WRITE (ISYSWR, 910) (COLHDU(KK),KK=1,NCOL)
128 WRITE (ISYSWR, 911) (COLHDL(KK),KK=1,NCOL)
129 910 FORMAT (/' EXT PARAMETER ', 13X ,6A14)
130 911 FORMAT ( ' NO. NAME ',' VALUE ',6A14)
131C
132C . . . loop over parameters . .
133 DO 200 I= 1, NU
134 IF (NVARL(I) .LT. 0) GO TO 200
135 L = NIOFEX(I)
136 CNAMBF = CBLANK(1:NADD)//CPNAM(I)
137 IF (L .EQ. 0) GO TO 55
138C variable parameter.
139 X1 = WERR(L)
140 CX2 = CGETX
141 CX3 = CGETX
142 IF (IKODE .EQ. 1) THEN
143 IF (NVARL(I) .LE. 1) THEN
144 WRITE (ISYSWR, 952) I,CNAMBF,U(I),X1
145 GO TO 200
146 ELSE
147 X2 = ALIM(I)
148 X3 = BLIM(I)
149 ENDIF
150 ENDIF
151 IF (IKODE .EQ. 2) THEN
152 X2 = DIRIN(L)
153 X3 = X(L)
154 ENDIF
155 IF (IKODE .EQ. 3) THEN
156 X2 = DIRIN(L)
157 X3 = GRD(L)
158 IF (NVARL(I).GT.1 .AND. ABS(COS(X(L))) .LT. 0.001)
159 + CX3 = '** at limit **'
160 ENDIF
161 IF (IKODE .EQ. 4) THEN
162 X2 = ERN(L)
163 IF (X2.EQ.ZERO) CX2=' '
164 IF (X2.EQ.UNDEFI) CX2=' at limit '
165 X3 = ERP(L)
166 IF (X3.EQ.ZERO) CX3=' '
167 IF (X3.EQ.UNDEFI) CX3=' at limit '
168 ENDIF
169 IF (CX2.EQ.CGETX) WRITE (CX2,'(G14.5)') X2
170 IF (CX3.EQ.CGETX) WRITE (CX3,'(G14.5)') X3
171 WRITE (ISYSWR,952) I,CNAMBF,U(I),X1,CX2,CX3
172 952 FORMAT (I4,1X,A11,2G14.5,2A)
173C check if parameter is at limit
174 IF (NVARL(I) .LE. 1 .OR. IKODE .EQ. 3) GO TO 200
175 IF (ABS(COS(X(L))) .LT. 0.001) WRITE (ISYSWR,1004)
176 1004 FORMAT (1H ,32X,42HWARNING - - ABOVE PARAMETER IS AT LIMIT.)
177 GO TO 200
178C
179C print constant or fixed parameter.
180 55 CONTINUE
181 COLHDU(1) = ' constant '
182 IF (NVARL(I).GT.0) COLHDU(1) = ' fixed '
183 IF (NVARL(I).EQ.4 .AND. IKODE.EQ.1) THEN
184 WRITE (ISYSWR,'(I4,1X,A11,G14.5,A,2G14.5)')
185 + I,CNAMBF,U(I),COLHDU(1),ALIM(I),BLIM(I)
186 ELSE
187 WRITE (ISYSWR,'(I4,1X,A11,G14.5,A)') I,CNAMBF,U(I),COLHDU(1)
188 ENDIF
189 200 CONTINUE
190C
191 IF (UP.NE.UPDFLT) WRITE (ISYSWR,'(31X,A,G10.3)') 'ERR DEF=',UP
192 700 CONTINUE
193 RETURN
194 END
Note: See TracBrowser for help on using the repository browser.