FTN4 SUBROUTINE ERROT(N),92069-16001 REV.1912 780809 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18008 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C ERROT GENERATES THE ERROR MESSAGE:*****ERROR NO. XXXXXX C WHERE XXX IS THE ERROR MESSAGE NO. C IF LIST OPTION IS TURNED OFF , IT LISTS THE ERROR LINE C IT INCREMENTS THE ERROR COUNT,ERROR C CALLING SEQUENCE C CALL ERROT(N) C N IS THE MESSAGE NO. C*********************************************************************** C C C INTEGER OUTCHR DIMENSION MESS(10),IA(3) DIMENSION IOBUF(41) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA I2,N20/2,-20/ DATA MESS/2H *,2H**,2H**,2HER,2HRO,2HR ,2HNO,2H. / C C C C C C C IF END OF FILE DO NOT LIST C IF (N.LT.0) N=-N IF (N.LT.100) GOTO 101 IF (N.EQ.209) GO TO 101 C C IF LISTING TURNED OFF, LIST ERROR LINE C IF (LST .EQ. TRUE) GO TO 101 C MOVE RECORD TO OUTPUT BUFFER AND LIST, LINE BY LINE NCHAR=LOG ICHAR=1 100 JCHAR=NCHAR IF (NCHAR.GT.80) JCHAR=80 OUTCHR=JCHAR+1 CALL SMOVE(CARD,ICHAR,(ICHAR+JCHAR-1),IOBUF,I2,OUTCHR) OUTCHR=-OUTCHR CALL OUTLN(IOBUF,OUTCHR/2+1) IF (NCHAR.LE.80) GO TO 101 NCHAR=NCHAR-80 ICHAR=ICHAR+80 GO TO 100 C CONVERT N TO ASCII AND ENTER N IN MESS (ERROR MESSAGE) 101 CALL CITA(N,IA) MESS(9)=IA(2) MESS(10)=IA(3) C WRITE ERROR MESSAGE ON LIST DEVICE CALL OUTLN(MESS,10) C INCREMENT ERROR COUNT ERROR=ERROR+1 RETURN END END$