SUBROUTINE FERROR (ERRCOD) IMPLICIT INTEGER (A-Z) INTEGER*2 LUN,LEN INTEGER*2 ERRCOD INTEGER*2 WICHBF,CHSTAT,BFPTR,INBLK,MXINLV,MXINPL BYTE INBUF COMMON /FLXSY3/ INBUF (512,2,4),WICHBF(4),CHSTAT(4),BFPTR(4) 1 ,INBLK(4),MXINLV,MXINPL DATA MXINLV /4/ DATA MXINPL /100/ INTEGER*2 FORLUN,LSTLUN,ERRLUN,NEWLUN,FLXLUN(4),INLEVL COMMON /FLXSY3/FORLUN,LSTLUN,ERRLUN,NEWLUN,FLXLUN ,INLEVL INTEGER*2 INPLIN,FORLIN,LASTLN,PAGLIN COMMON /FLXSY3/ INPLIN,FORLIN,LASTLN,PAGLIN BYTE OUTBUF INTEGER*2 OPTR,WICHOB,OSTAT,OCHAN,OBLK,MXOLUN COMMON /FLXSY3/ OUTBUF(512,2,3),OPTR(3),WICHOB(3), 1 OSTAT(3),OCHAN(3),OBLK(3),MXOLUN DATA MXOLUN /3/ INTEGER TITLN1(68) COMMON /FLXSY3/ TITLN1 INTEGER*2 EREADE, EWRITE, ECLOSE, EWAITE DATA EREADE /1/, EWRITE /2/, ECLOSE /3/, EWAITE /4/ COMMON /FLXSY3/ EREADE, EWRITE, ECLOSE, EWAITE BYTE SSCRAT (200) COMMON /FLXSY3/ SSCRAT LOGICAL*1 NOFORT,NOLIST,TTYLST,DEBUG,FINLST,LSTCOM,NOLNUM COMMON /FLXSY3/ NOFORT,NOLIST,TTYLST,DEBUG,FINLST,LSTCOM,NOLNUM LOGICAL*1 LSTFLG COMMON /FLXSY3/ LSTFLG IF((EREADE).NE.(ERRCOD)) GO TO 32765 CALL PRINT (' FLECS-F-Read error') GO TO 32766 32765 IF((EWRITE).NE.(ERRCOD)) GO TO 32764 CALL PRINT (' FLECS-F-Write error') GO TO 32766 32764 IF((ECLOSE).NE.(ERRCOD)) GO TO 32763 CALL PRINT (' FLECS-F-Error closing files') GO TO 32766 32763 IF((EWAITE).NE.(ERRCOD)) GO TO 32762 CALL PRINT (' FLECS-F-Wait error') 32762 CONTINUE 32766 DO 32760 LUN=1,3 CHAN = OCHAN (LUN) IF(.NOT.((CHAN .GE. 0) .AND. (CHAN .LT. 16))) GO TO 32759 CALL PURGE (CHAN) CALL IFREEC (CHAN) 32759 CONTINUE 32760 CONTINUE 32761 DO 32757 I = 1,4 CHAN = FLXLUN(I) IF(.NOT.((CHAN .GE. 0) .AND. (CHAN .LT. 16))) GO TO 32756 CALL PURGE (CHAN) CALL IFREEC (CHAN) 32756 CONTINUE 32757 CONTINUE 32758 STOP ' ?FATAL ERROR IN FLECS SEE MESSAGE ABOVE' END