| 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"
|
|---|
| 12 | CC Called from MNREAD and user-callable
|
|---|
| 13 | CC Implements one parameter definition, that is:
|
|---|
| 14 | CC parses the string CRDBUF and calls MNPARM
|
|---|
| 15 | C
|
|---|
| 16 | C output conditions:
|
|---|
| 17 | C ICONDN = 0 all OK
|
|---|
| 18 | C ICONDN = 1 error, attempt to define parameter is ignored
|
|---|
| 19 | C ICONDN = 2 end of parameter definitions
|
|---|
| 20 | C
|
|---|
| 21 | #include "minuit/d506cm.inc"
|
|---|
| 22 | C
|
|---|
| 23 | DIMENSION PLIST(MAXP)
|
|---|
| 24 | CHARACTER CNAMK*10, CRDBUF*(*) , CELMNT*20 , COMAND*(MAXCWD)
|
|---|
| 25 | C
|
|---|
| 26 | LENBUF = LEN(CRDBUF)
|
|---|
| 27 | C 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
|
|---|
| 32 | C new (free-field) format
|
|---|
| 33 | KAPO2 = KAPO2 + KAPO1
|
|---|
| 34 | C 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
|
|---|
| 40 | C 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)
|
|---|
| 47 | C 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
|
|---|
| 72 | C 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
|
|---|
| 78 | C parameter format cracked, implement parameter definition
|
|---|
| 79 | 170 CALL MNPARM(K,CNAMK,UK,WK,A,B,IERR)
|
|---|
| 80 | ICONDN = IERR
|
|---|
| 81 | RETURN
|
|---|
| 82 | C format or other error
|
|---|
| 83 | 180 CONTINUE
|
|---|
| 84 | ICONDN = 1
|
|---|
| 85 | RETURN
|
|---|
| 86 | C end of data
|
|---|
| 87 | 210 CONTINUE
|
|---|
| 88 | ICONDN = 2
|
|---|
| 89 | RETURN
|
|---|
| 90 | END
|
|---|
![(please configure the [header_logo] section in trac.ini)](/PI/chrome/site/your_project_logo.png){kind=logo}
