Return to ERROR2.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

Annotation of researchv10no/cmd/pfort/ERROR2.f, revision 1.1

1.1     ! root        1:       SUBROUTINE ERROR2( I,  JJ, K, NN, SPBEF, SPAFT )
        !             2: C
        !             3: C     PRINTS ERROR MESSAGES AND SYMBOLIC NAME
        !             4: C     I IS PACKED HOLLERITH STRING
        !             5: C     JJ IS NUMBER OF CHARACTERS TO BE PRINTED ( N = JJ)
        !             6: C     K CONTAINS INTEGER OR HOLLERITH INFO TO FOLLOW MESSAGE
        !             7: C     NN CONTROLS TYPE OF LINE TO BE PRINTED
        !             8: C
        !             9: C     NN = 0 MEANS PRINT MESSAGE
        !            10: C
        !            11: C     NN < 0 MEANS IF JJ=0 NO MESSAGE, ELSE PRINT MESSAGE
        !            12: C     ON NEXT LINE IF NN = -1 PRINT PGM UNIT AND/OR STMT NO
        !            13: C     (CONTROLLED BY CONTENTS OF K).
        !            14: C     ON NEXT LINE IF NN = -2 PRINT PARAMETER NUMBER IN K
        !            15: C     NN = -3 USED FOR SPACING CONTROL IN LONG MESSAGES
        !            16: C
        !            17: C     NN > 0 MEANS PRINT MESSAGE FOLLOWED BY IDENTIFIER IN K
        !            18: C     SPBEF, SPAFT CONTROL LINE SPACING BEFORE AND AFTER MESSAGE
        !            19: C     IF = 1, BLANK LINE EMMITTED
        !            20: C
        !            21:       INTEGER I(1), J(80), OUTUT, PDSA, DSA, M(6), K(6), W
        !            22:       INTEGER SPBEF, SPAFT
        !            23:       LOGICAL OPT, P1ERR, P2, QBR
        !            24:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
        !            25:       COMMON /PARAMS/ INUT, OUTUT, NOCHAR, I1, I2, I3, I4
        !            26:       COMMON /FACTS/ NAME, NOST, ITYP, IASF
        !            27:       COMMON /OPTNS/ OPT(5), P1ERR
        !            28:       COMMON /PASS/ P2, QBR
        !            29:       DATA W /1HW/, KK /1H-/
        !            30: C
        !            31: C     ERROR IN P.U. DURING PROCESSING OF A HEADING STMT, SPECIFI STMT,
        !            32: C     EQUIV STMT, OR DATA STMT CAUSES PASS 2 TO BE SUPPRESSED FOR THAT
        !            33: C     P.U.
        !            34: C
        !            35:       IF (QBR) GOTO 45
        !            36:       IF(SPBEF.EQ.1) WRITE(OUTUT, 99998)
        !            37:       N = JJ
        !            38:       IF (N.GT.72) N = 72
        !            39:       J(2) = KK
        !            40:       IF (N.GE.1) CALL S5UNPK(I, J, N)
        !            41:       IF (ITYP.LT.14 .AND. J(2).NE.W) P1ERR = .TRUE.
        !            42:       IF (NN) 50, 10, 30
        !            43: C
        !            44: C     NN=0
        !            45: C
        !            46:    10 CONTINUE
        !            47:       WRITE (OUTUT,99997) (J(L),L=1,N)
        !            48:       IF(P2 .OR. OPT(4)) GOTO 40
        !            49:       CALL S5UNPK(DSA(NAME+4), J(1), 6)
        !            50:       WRITE (OUTUT,99999) NOST, (J(L),L=1,6)
        !            51: 99999 FORMAT (16H *** AT STMT NO , I6, 13H IN PGM UNIT , 6A1)
        !            52: 99998 FORMAT(1H )
        !            53:       GO TO 40
        !            54: C
        !            55: C     NN>0
        !            56: C
        !            57:    30 CONTINUE
        !            58:       IF (N.GT.68) N = 68
        !            59:       CALL S5UNPK(K, J(73), 6)
        !            60:       WRITE (OUTUT,99997) (J(L),L=1,N), KK, KK, (J(L),L=73,78)
        !            61: 99997 FORMAT (4H ***, 76A1)
        !            62:  40   IF(SPAFT.EQ.1) WRITE(OUTUT, 99998)
        !            63:  45   RETURN
        !            64: C
        !            65: C     NN<0
        !            66: C
        !            67:    50 CONTINUE
        !            68:       IF (N.GE.1) WRITE (OUTUT,99997) (J(L),L=1,N)
        !            69:       IF( -2.EQ.NN ) GOTO 70
        !            70:       IF( -3.EQ.NN ) GOTO 40
        !            71:       CALL S5UNPK(DSA(NAME+4), M(1), 6)
        !            72: C     WRITE OUT STMT NO AND/OR PGM UNIT
        !            73:       IF (K(1).EQ.0) GO TO 60
        !            74:       WRITE (OUTUT,99996) K(1), (M(L),L=1,6)
        !            75: 99996 FORMAT (16H *** AT STMT NO , I6, 1X, 13H IN PGM UNIT , 6A1)
        !            76:       GO TO 40
        !            77:    60 WRITE (OUTUT,99995) (M(L),L=1,6)
        !            78: 99995 FORMAT (17H *** IN PGM UNIT , 6A1)
        !            79:       GO TO 40
        !            80: C     WRITE OUT PARAMETER NO FOR PARAMETERLIST ERRORS
        !            81:  70   WRITE(OUTUT,99994) K(1)
        !            82: 99994 FORMAT(22H *** PARAMETER NUMBER ,I6)
        !            83:       GOTO 40
        !            84:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.