![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FORMAT.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / pfort|
Return to FORMAT.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 ! root 1: SUBROUTINE FORMAT ! 2: INTEGER STMT, PSTMT ! 3: LOGICAL TOKPNO, SIGN, ERROR ! 4: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) ! 5: C ! 6: C ROUTINE PROCESSES FORMAT STMT ! 7: C FORMAT (Q1 T1 Z1 T2 Z2 ... TN Q2) ! 8: C Q1,Q2 ARE EMPTY OR ARE SEPARARTERS ! 9: C T1,T2 ETC. ARE FORMAT-ITEMS ! 10: C Z1,Z2, ETC. ARE SEPARATERS ! 11: C CHECKS FOR <= 2 LEVELS OF PARENTHESES ! 12: C ! 13: ERROR = .FALSE. ! 14: ICNT = 0 ! 15: C ! 16: C "(" ! 17: C ! 18: IF (STMT(PSTMT).EQ.65) GO TO 30 ! 19: 10 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) ! 20: C ! 21: C SEARCH FOR FORMAT ITEMS ! 22: C ! 23: 20 RETURN ! 24: 30 ICNT = ICNT + 1 ! 25: IF (ICNT.GT.2) CALL ERROR1(28H TOO MANY PARENTHESES LEVELS, 28) ! 26: PSTMT = PSTMT + 1 ! 27: C ! 28: C LOOK FOR Q1 ! 29: C ! 30: CALL SEPAR(I) ! 31: C TAKES CARE OF FORMAT() ! 32: IF (STMT(PSTMT).EQ.62) GO TO 180 ! 33: IF (STMT(PSTMT-1).EQ.68) CALL ERROR1(25H ILLEGAL PUNCTUATION (, , ! 34: * 25) ! 35: 40 IF (STMT(PSTMT).EQ.65) GO TO 30 ! 36: IF (PSTMT.GE.NSTMT) GO TO 10 ! 37: SIGN = .FALSE. ! 38: C ! 39: C SEARCH FOR REPEAT FACTER (POSITIVE INTEGER) ! 40: C ! 41: IF (TOKPNO(PSTMT,K2,N)) GO TO 70 ! 42: C ! 43: C HOLLERITH STRINGS ! 44: C ! 45: IF (STMT(PSTMT).LT.0) GO TO 120 ! 46: C ! 47: C "-" IN P SCALING FORMAT-ITEM ! 48: C ! 49: IF (STMT(PSTMT).NE.61) GO TO 50 ! 50: SIGN = .TRUE. ! 51: PSTMT = PSTMT + 1 ! 52: 50 IF (PSTMT.GE.NSTMT) GO TO 10 ! 53: C ! 54: C LOOK FOR <INT> IN PSCALING FORMAT-ITEM ! 55: C P SCALING FORMAT-ITEM ! 56: C ( - ) <INTEGER> P REPEAT (A,I,L) <WIDTH> . <INT> ! 57: C ! 58: CALL NEXTOK(PSTMT, K2, K) ! 59: C ! 60: C CHECK FOR USE OF "-" WITH NON P-SCALING CONSTRUCTS ! 61: C ! 62: IF (K.NE.1 .AND. SIGN) GO TO 100 ! 63: IF (K.EQ.1) GO TO 60 ! 64: N = STMT(PSTMT) ! 65: GO TO 90 ! 66: 60 SIGN = .TRUE. ! 67: PSTMT = K2 ! 68: N = STMT(PSTMT) ! 69: GO TO 80 ! 70: C ! 71: C LOOK FOR PART OF FORMAT-ITEM AFTER REPEAT FACTOR ! 72: C ! 73: 70 PSTMT = K2 ! 74: N = STMT(PSTMT) ! 75: C ! 76: C "(" ! 77: C ! 78: IF (N.EQ.65) GO TO 30 ! 79: C ! 80: C "X" ! 81: C ! 82: IF (N.EQ.53) GO TO 120 ! 83: C ! 84: C "P" ! 85: C ! 86: 80 IF (N.EQ.45) GO TO 130 ! 87: IF (SIGN) GO TO 100 ! 88: C ! 89: C A,I,L ! 90: C ! 91: 90 IF (N.EQ.30 .OR. N.EQ.38 .OR. N.EQ.41) GO TO 110 ! 92: C ! 93: C D,E,F,G ! 94: C ! 95: IF (N.GE.33 .AND. N.LE.36) GO TO 150 ! 96: 100 CALL ERROR1(20H ILLEGAL FORMAT ITEM, 20) ! 97: GO TO 20 ! 98: C ! 99: C A,I,L FOUND. LOOK FOR <WIDTH> ! 100: C ! 101: 110 IF (PSTMT+1.GE.NSTMT) GO TO 10 ! 102: PSTMT = PSTMT + 1 ! 103: IF (.NOT.TOKPNO(PSTMT,K2,I)) GO TO 100 ! 104: IF (N.NE.30 .OR. I.EQ.1 .OR. ERROR) GO TO 160 ! 105: CALL ERROR1(48H WARNING - A FORMAT ITEM NOT PORTABLE FOR N.GT.1, ! 106: * 48) ! 107: ERROR = .TRUE. ! 108: GO TO 160 ! 109: C ! 110: C SKIP TO NEXT CHAR IN X OR HOLLERITH ! 111: C ! 112: 120 PSTMT = PSTMT + 1 ! 113: GO TO 170 ! 114: C ! 115: C LOOK FOR CONSTRUCT FOLLOWING THE P. CAN BE A REPEAT ! 116: C ! 117: 130 IF (PSTMT+1.GE.NSTMT) GO TO 10 ! 118: PSTMT = PSTMT + 1 ! 119: IF (STMT(PSTMT).GT.9 .OR. STMT(PSTMT).LT.0) GO TO 140 ! 120: CALL NEXTOK(PSTMT, K2, K) ! 121: IF (K.NE.1) GO TO 10 ! 122: PSTMT = K2 ! 123: C ! 124: C AFTER D,E,F,G FIND <WIDTH> . <INT> ! 125: C ! 126: 140 IF (STMT(PSTMT).LT.33 .OR. STMT(PSTMT).GT.36) GO TO 10 ! 127: 150 IF (PSTMT+1.GE.NSTMT) GO TO 10 ! 128: PSTMT = PSTMT + 1 ! 129: IF (.NOT.TOKPNO(PSTMT,K2,N)) GO TO 100 ! 130: IF (STMT(K2).NE.64) GO TO 100 ! 131: IF (K2+1.GE.NSTMT) GO TO 10 ! 132: PSTMT = K2 + 1 ! 133: CALL NEXTOK(PSTMT, K2, K) ! 134: IF (K.NE.1) GO TO 100 ! 135: 160 PSTMT = K2 ! 136: C ! 137: C FINISHED A FORMAT-ITEM ! 138: C LOOK FOR SEPARATER OR ")" ! 139: C ! 140: 170 IF (STMT(PSTMT).NE.62) GO TO 210 ! 141: 180 ICNT = ICNT - 1 ! 142: IF (ICNT.LT.0) GO TO 190 ! 143: IF (PSTMT+1.LT.NSTMT) GO TO 200 ! 144: IF (ICNT.EQ.0) GO TO 20 ! 145: 190 CALL ERROR1(28H ILLEGAL PARENTHESES NESTING, 28) ! 146: GO TO 20 ! 147: 200 PSTMT = PSTMT + 1 ! 148: GO TO 170 ! 149: 210 CALL SEPAR(I) ! 150: IF (I.EQ.0) CALL ERROR1(24H MISSING FIELD SEPARATOR, 24) ! 151: IF (STMT(PSTMT).NE.62) GO TO 40 ! 152: IF (STMT(PSTMT-1).EQ.68) CALL ERROR1(25H ILLEGAL PUNCTUATION ,) , ! 153: * 25) ! 154: GO TO 180 ! 155: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.