source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnpars.F@ 2907

Last change on this file since 2907 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: 2.6 KB
RevLine 
[2403]1*
2* $Id: mnpars.F,v 1.1.1.1 2003-06-11 14:18:28 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 MNPARS(CRDBUF,ICONDN)
11#include "minuit/d506dp.inc"
12CC Called from MNREAD and user-callable
13CC Implements one parameter definition, that is:
14CC parses the string CRDBUF and calls MNPARM
15C
16C output conditions:
17C ICONDN = 0 all OK
18C ICONDN = 1 error, attempt to define parameter is ignored
19C ICONDN = 2 end of parameter definitions
20C
21#include "minuit/d506cm.inc"
22C
23 DIMENSION PLIST(MAXP)
24 CHARACTER CNAMK*10, CRDBUF*(*) , CELMNT*20 , COMAND*(MAXCWD)
25C
26 LENBUF = LEN(CRDBUF)
27C find out whether fixed or free-field format
28 KAPO1 = INDEX(CRDBUF,'''')
29 IF (KAPO1 .EQ. 0) GO TO 150
30 KAPO2 = INDEX(CRDBUF(KAPO1+1:),'''')
31 IF (KAPO2 .EQ. 0) GO TO 150
32C new (free-field) format
33 KAPO2 = KAPO2 + KAPO1
34C skip leading blanks if any
35 DO 115 ISTART=1, KAPO1-1
36 IF (CRDBUF(ISTART:ISTART) .NE. ' ') GO TO 120
37 115 CONTINUE
38 GO TO 210
39 120 CONTINUE
40C parameter number integer
41 CELMNT = CRDBUF(ISTART:KAPO1-1)
42 READ (CELMNT,'(BN,F20.0)',ERR=180) FK
43 K = FK
44 IF (K .LE. 0) GO TO 210
45 CNAMK = 'PARAM '//CELMNT
46 IF (KAPO2-KAPO1 .GT. 1) CNAMK = CRDBUF(KAPO1+1:KAPO2-1)
47C special handling if comma or blanks and a comma follow 'name'
48 DO 135 ICY= KAPO2+1,LENBUF
49 IF (CRDBUF(ICY:ICY) .EQ. ',') GO TO 139
50 IF (CRDBUF(ICY:ICY) .NE. ' ') GO TO 140
51 135 CONTINUE
52 UK = 0.
53 WK = 0.
54 A = 0.
55 B = 0.
56 GO TO 170
57 139 CONTINUE
58 ICY = ICY+1
59 140 CONTINUE
60 IBEGIN = ICY
61 CALL MNCRCK(CRDBUF(IBEGIN:),MAXCWD,COMAND,LNC,
62 + MAXP,PLIST,LLIST, IERR,ISYSWR)
63 IF (IERR .GT. 0) GO TO 180
64 UK = PLIST(1)
65 WK = 0.
66 IF (LLIST .GE. 2) WK = PLIST(2)
67 A = 0.
68 IF (LLIST .GE. 3) A = PLIST(3)
69 B = 0.
70 IF (LLIST .GE. 4) B = PLIST(4)
71 GO TO 170
72C old (fixed-field) format
73 150 CONTINUE
74 READ (CRDBUF, 158,ERR=180) XK,CNAMK,UK,WK,A,B
75 158 FORMAT (BN,F10.0, A10, 4F10.0)
76 K = XK
77 IF (K .EQ. 0) GO TO 210
78C parameter format cracked, implement parameter definition
79 170 CALL MNPARM(K,CNAMK,UK,WK,A,B,IERR)
80 ICONDN = IERR
81 RETURN
82C format or other error
83 180 CONTINUE
84 ICONDN = 1
85 RETURN
86C end of data
87 210 CONTINUE
88 ICONDN = 2
89 RETURN
90 END
Note: See TracBrowser for help on using the repository browser.