source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnread.F@ 2864

Last change on this file since 2864 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.9 KB
RevLine 
[2403]1*
2* $Id: mnread.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 MNREAD(FCN,IFLGIN,IFLGUT,FUTIL)
11#include "minuit/d506dp.inc"
12CC Called from MINUIT. Reads all user input to MINUIT.
13CC This routine is highly unstructured and defies normal logic.
14CC
15CC IFLGIN indicates the function originally requested:
16CC = 1: read one-line title
17CC 2: read parameter definitions
18CC 3: read MINUIT commands
19CC
20CC IFLGUT= 1: reading terminated normally
21CC 2: end-of-data on input
22CC 3: unrecoverable read error
23CC 4: unable to process parameter requests
24CC 5: more than 100 incomprehensible commands
25CC internally,
26CC IFLGDO indicates the subfunction to be performed on the next
27CC input record: 1: read a one-line title
28CC 2: read a parameter definition
29CC 3: read a command
30CC 4: read in covariance matrix
31CC for example, when IFLGIN=3, but IFLGDO=1, then it should read
32CC a title, but this was requested by a command, not by MINUIT.
33CC
34#include "minuit/d506cm.inc"
35 EXTERNAL FCN,FUTIL
36 CHARACTER CRDBUF*80, CUPBUF*10
37 CHARACTER CPROMT(3)*40, CLOWER*26, CUPPER*26
38 LOGICAL LEOF
39 DATA CPROMT/' ENTER MINUIT TITLE, or "SET INPUT n" : ',
40 + ' ENTER MINUIT PARAMETER DEFINITION: ',
41 + ' ENTER MINUIT COMMAND: '/
42C
43 DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
44 DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
45C
46 IFLGUT = 1
47 IFLGDO = IFLGIN
48 LEOF = .FALSE.
49 INCOMP = 0
50C . . . . read next record
51 10 CONTINUE
52 IF (ISW(6) .EQ. 1) THEN
53 WRITE (ISYSWR,'(A)') CPROMT(IFLGDO)
54 IF (IFLGDO .EQ. 2) LPHEAD = .FALSE.
55 ENDIF
56 CRDBUF = ' '
57 READ (ISYSRD,'(A)',ERR=500,END=45) CRDBUF
58C
59C CUPBUF is the first few characters in upper case
60 CUPBUF(1:10) = CRDBUF(1:10)
61 DO 12 I= 1, 10
62 IF (CRDBUF(I:I) .EQ. '''') GO TO 13
63 DO 11 IC= 1, 26
64 IF (CRDBUF(I:I) .EQ. CLOWER(IC:IC)) CUPBUF(I:I)=CUPPER(IC:IC)
65 11 CONTINUE
66 12 CONTINUE
67 13 CONTINUE
68C . . preemptive commands
69 LEOF = .FALSE.
70 IF (INDEX(CUPBUF,'*EOF') .EQ. 1) THEN
71 WRITE (ISYSWR,'(A,I3)') ' *EOF ENCOUNTERED ON UNIT NO.',ISYSRD
72 LPHEAD = .TRUE.
73 GO TO 50
74 ENDIF
75 IF (INDEX(CUPBUF,'SET INP') .EQ. 1) THEN
76 ICOMND = ICOMND + 1
77 WRITE (ISYSWR, 21) ICOMND,CRDBUF(1:50)
78 21 FORMAT (' **********'/' **',I5,' **',A/' **********')
79 LPHEAD = .TRUE.
80 GO TO 50
81 ENDIF
82 GO TO 80
83C . . hardware EOF on current ISYSRD
84 45 CRDBUF = '*EOF '
85 WRITE (ISYSWR,'(A,I3)') ' END OF DATA ON UNIT NO.',ISYSRD
86C or SET INPUT command
87 50 CONTINUE
88 CALL MNSTIN(CRDBUF,IERR)
89 IF (IERR .EQ. 0) GO TO 10
90 IF (IERR .EQ. 2) THEN
91 IF (.NOT. LEOF) THEN
92 WRITE (ISYSWR,'(A,A/)') ' TWO CONSECUTIVE EOFs ON ',
93 + 'PRIMARY INPUT FILE WILL TERMINATE EXECUTION.'
94 LEOF = .TRUE.
95 GO TO 10
96 ENDIF
97 ENDIF
98 IFLGUT = IERR
99 GO TO 900
100 80 IF (IFLGDO .GT. 1) GO TO 100
101C read title . . . . . IFLGDO = 1
102C if title is 'SET TITLE', skip and read again
103 IF (INDEX(CUPBUF,'SET TIT') .EQ. 1) GO TO 10
104 CALL MNSETI(CRDBUF(1:50))
105 WRITE (ISYSWR,'(1X,A50)') CTITL
106 WRITE (ISYSWR,'(1X,78(1H*))')
107 LPHEAD = .TRUE.
108 IF (IFLGIN .EQ. IFLGDO) GO TO 900
109 IFLGDO = IFLGIN
110 GO TO 10
111C data record is not a title.
112 100 CONTINUE
113 IF (IFLGDO .GT. 2) GO TO 300
114C expect parameter definitions. IFLGDO = 2
115C if parameter def is 'PARAMETER', skip and read again
116 IF (INDEX(CUPBUF,'PAR') .EQ. 1) GO TO 10
117C if line starts with SET TITLE, read a title first
118 IF (INDEX(CUPBUF,'SET TIT') .EQ. 1) THEN
119 IFLGDO = 1
120 GO TO 10
121 ENDIF
122C we really have parameter definitions now
123 CALL MNPARS(CRDBUF,ICONDP)
124 IF (ICONDP .EQ. 0) GO TO 10
125C format error
126 IF (ICONDP .EQ. 1) THEN
127 IF (ISW(6) .EQ. 1) THEN
128 WRITE (ISYSWR,'(A)') ' FORMAT ERROR. IGNORED. ENTER AGAIN.'
129 GO TO 10
130 ELSE
131 WRITE (ISYSWR,'(A)') ' ERROR IN PARAMETER DEFINITION'
132 IFLGUT = 4
133 GO TO 900
134 ENDIF
135 ENDIF
136C ICONDP = 2 . . . end parameter requests
137 IF (ISW(5).GE.0 .AND. ISW(6).LT.1) WRITE (ISYSWR,'(4X,75(1H*))')
138 LPHEAD = .TRUE.
139 IF (IFLGIN .EQ. IFLGDO) GO TO 900
140 IFLGDO = IFLGIN
141 GO TO 10
142C . . . . . IFLGDO = 3
143C read commands
144 300 CONTINUE
145 CALL MNCOMD(FCN,CRDBUF,ICONDN,FUTIL)
146CC ICONDN = 0: command executed normally
147CC 1: command is blank, ignored
148CC 2: command line unreadable, ignored
149CC 3: unknown command, ignored
150CC 4: abnormal termination (e.g., MIGRAD not converged)
151CC 5: command is a request to read PARAMETER definitions
152CC 6: 'SET INPUT' command
153CC 7: 'SET TITLE' command
154CC 8: 'SET COVAR' command
155CC 9: reserved
156CC 10: END command
157CC 11: EXIT or STOP command
158CC 12: RETURN command
159 IF (ICONDN .EQ. 2 .OR. ICONDN .EQ. 3) THEN
160 INCOMP = INCOMP + 1
161 IF (INCOMP .GT. 100) THEN
162 IFLGUT = 5
163 GO TO 900
164 ENDIF
165 ENDIF
166C parameter
167 IF (ICONDN .EQ. 5) IFLGDO = 2
168C SET INPUT
169 IF (ICONDN .EQ. 6) GO TO 50
170C SET TITLE
171 IF (ICONDN .EQ. 7) IFLGDO = 1
172C . . . . . . . . . . set covar
173 IF (ICONDN .EQ. 8) THEN
174 ICOMND = ICOMND + 1
175 WRITE (ISYSWR,405) ICOMND,CRDBUF(1:50)
176 405 FORMAT (1H ,10(1H*)/' **',I5,' **',A)
177 WRITE (ISYSWR, '(1H ,10(1H*))' )
178 NPAR2 = NPAR*(NPAR+1)/2
179 READ (ISYSRD,420,ERR=500,END=45) (VHMAT(I),I=1,NPAR2)
180 420 FORMAT (BN,7E11.4,3X)
181 ISW(2) = 3
182 DCOVAR = 0.0
183 IF (ISW(5) .GE. 0) CALL MNMATU(1)
184 IF (ISW(5) .GE. 1) CALL MNPRIN(2,AMIN)
185 GO TO 10
186 ENDIF
187 IF (ICONDN .LT. 10) GO TO 10
188 GO TO 900
189C . . . . error conditions
190 500 IFLGUT = 3
191 900 RETURN
192 END
Note: See TracBrowser for help on using the repository browser.