FTN4
      SUBROUTINE SETD(IVAL),92069-16001 REV.1912 780814 
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-18007
C     RELOC:     92069-16001
C 
C 
C************************************************************ 
C 
C***********************************************************************
C SETD GETS THE NEXT CARD IMAGE AND 
C     RETURNS  IVAL=0 IF '$SET:' FOUND STARTING IN COL 1
C              IVAL=1 IF '$END' FOUND STARTING IN COL 1 
C              IVAL = -1 IF I O ERROR OCCURED 
C              IVAL = 2 OTHERWISE 
C 
C          IF IVAL = -1 THEN AN I/O ERROR OCCURED 
C          IF IVAL=1 SCANS TO THE NEXT '$SET:' OR '$END' CARD 
C                    AND SETS IVAL AS ABOVE 
C          IF IVAL=0 PRINTS ERROR MESSAGE IF NEITHER '$SET:' OR '$END'
C                    IS FOUND ON NEXT CARD, AND 
C                    SCANS TO THE NEXT '$SET:' OR '$END' CARD 
C                    AND SETS IVAL AS ABOVE.
C          IF IVAL=2 AND NEITHER '$SET:' OR '$END' IS PRESENT ON THE
C                    NEXT CARD, IVAL IS SET TO 2. 
C 
C CALLING SEQUENCE
C     CALL SETD(IVAL) 
C***********************************************************************
C 
C 
      INTEGER PRINT 
      INTEGER SET(3),END(2) 
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 I1,I4,I5,I205/1,4,5,205/ 
      DATA SET/2H$S,2HET,2H: /
      DATA END/2H$E,2HND/ 
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
C 
C 
C 
C 
C 
C 
      IERR=0
C 
C INITIALIZE PRINT FLAG 
C 
      PRINT=0 
C 
C     GET NEXT CARD, IF I O ERROR SET IVAL -1 AND RETURN
C 
103   CALL CRDIM(IERR)
      IF(IERR .EQ. 0) GOTO 1031 
      IVAL = -1 
      RETURN
C 
C     IF "$SET:", SET IVAL TO 0 AND RETURN
C 
1031  CONTINUE
      IF ( JSCOM(CARD,I1,I5,SET,I1,IERR).NE.0) GO TO 101
      IVAL=0
      RETURN
C     IF "$END", SET IVAL TO 1 AND RETURN 
C 
101   IF ( JSCOM(CARD,I1,I4,END,I1,IERR).NE.0 ) GO TO 102 
      IVAL=1
      RETURN
C 
C     IF IVAL=2, NEITHER FOUND, RETURN
C 
102   IF (IVAL.EQ.2) RETURN 
C 
C     SCAN TO NEXT CARD AND.CHECK AGAIN 
C     IF IVAL=0 AND FIRST TIME AROUND, PRINT ERROR MESSAGE 205, 
C     "$SET: OR $END EXPECTED." 
C 
      IF  (IVAL.NE.0) GO TO 103 
      IF  (PRINT.NE.0) GO TO 103
      CALL ERROT(I205)
      PRINT=1 
      GO TO 103 
      END 
      END$
                                                                                                                                                              