FTN4
      SUBROUTINE GETVL(ISET,ITMNO,ITYPE,LEN,ELCNT,IVALU,P2,INBUF, 
     &    LU,IERR),92069-16061 REV.1912 790129
      INTEGER ELCNT,IVALU(2048),P2,INBUF(40),LU 
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-18095
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  THIS SUBROUTINE GETS AN ITEM VALUE FROM THE BUFFER "INBUF" AND 
C  PUTS IT IN THE BUFFER PASTED IN THE CALLING SEQUENCE.
C 
C  QUOTES MUST BE AROUND ALL INPUT
C 
C 
C CALLING SEQUENCE: 
C 
C    CALL GETVL(ISET,ITMNO,LEN,ELCNT,IVALU,P2,IERR) 
C 
C       WHERE:
C 
C       ISET
C       IS THE DATA SET NUMBER
C 
C       ITMNO 
C       IS THE DATA ITEM NUMBER 
C 
C       LEN 
C       IS THE DATA ITEM LENGTH 
C 
C       ELCNT 
C       IS THE NUMBER OF ELEMENTS IN THE ITEM'S ARRAY 
C 
C       IVALU 
C       IS A BUFFER WHICH WILL CONTAIN THE VALUES ON EXIT 
C       FROM GETVL.  ALL NUMERIC VALUES WILL BE CONVERTED 
C       TO THEIR BINARY EQUIVALENTS.
C 
C       P2
C       IS THE COLUMN DISPLACEMENT INTO THE IVALU BUFFER. 
C 
C       INBUF 
C       IS A BUFFER WHICH CONTAINS THE VALUE TO BE CONVERTED
C 
C       LU
C       IS THE LISTING LU 
C 
C 
C       IERR
C       IS AN ERROR INDICATOR 
C         IERR = 0 IMPLIES NO ERROR 
C         IERR = -1 IMPLIES ERROR 
C 
C 
C 
      INTEGER ERR4(15)
      INTEGER ERR5(11)
      INTEGER ERR6(19)
      INTEGER ERR7(10)
      INTEGER ILTERM(10)
      INTEGER X,R 
      INTEGER PP2 
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C 
      DATA SPACE/2H  /
C  INPUT TOO LONG - TRUNCATED 
      DATA ERR4/2H V,2HAL,2HUE,2H T,2HOO,2H L,
     1 2HON,2HG ,2H- ,2HIT,2HEM,2H I,2HGN,2HOR,2HED/
C     NON-NUMERIC INTEGER VALUE
      DATA ERR5/2H I,2HLL,2HEG,2HAL,
     1 2H I,2HNT,2HEG,2HER, 
     1 2H V,2HAL,2HUE/
C VALUE MUST HAVE QUOTES - ITEM IGNORED 
      DATA ERR6/2H V,2HAL,2HUE,2H M,2HUS,2HT ,
     &2HHA,2HVE,2H Q,2HUO,2HTE,2HS ,2H- ,2HIT,2HEM,2H I,2HGN, 
     &2HOR,2HED/
C NON-NUMERIC IN REAL VALUE 
      DATA ERR7/2H I,2HLL,2HEG,2HAL,
     &   2H R,2HEA,2HL ,2HVA,2HLU,2HE / 
      DATA R/122B/
      DATA X/130B/
C ILLEGAL TERMINATOR
      DATA ILTERM/2H I,2HLL,2HEG,2HAL,2H T,2HER,2HMI,2HNA,2HTO,2HR /
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C 
C  CLEAR ERROR
C 
      IERR = 0
C 
C SELECT THE CORRECT NULL VALUE 
C 
      NULL = 0
      IF(ITYPE .EQ. X) NULL = 40B 
      CALL SFILL(IVALU,P2,P2+LEN*ELCNT-1,NULL)
C 
C GET A VALUE FOR EVERY ELEMENT OF THE ARRAY
C 
      PP2 = P2
      DO 300 ICNT = 1,ELCNT 
      CALL LSCAN(INBUF,I,J,K) 
C 
C CHECK FOR SEMI
C 
      IF(K .EQ. 5) GOTO 310 
C 
C IF COMMA CONTINUE TO INCREMENT POINTER UNTIL THERE ARE NO MORE
C 
      IF(K .NE. 4) GOTO 200 
      PP2 = PP2 + LEN 
      GOTO 300
C 
C VERIFY VALUE IS ENCLOSED IN QUOTES
C 
200   CONTINUE
      IF(K .EQ. 3) GOTO 205 
      CALL ERIO(2,LU,ERR6,19) 
      GOTO 305
C 
C CONVERT TYPE
C 
205   CONTINUE
      IF(ITYPE.EQ.X) GOTO 240 
      IF(ITYPE.EQ.R) GOTO 230 
C 
C  CONVERT DATA TO INTEGER
C 
      INT = 0 
      IF(J-I .LT. 0) GOTO 220 
      CALL CATI(INBUF,I,J-I+1,INT,ISTAT)
      IF(ISTAT.EQ.0) GOTO 220 
C 
C  INTEGER VALUE ERROR - ITEM IGNORED 
C 
210   CALL ERIO(2,LU,ERR5,11) 
      GOTO 305
220   CONTINUE
      CALL SMOVE(INT,1,2,IVALU,PP2) 
      GOTO 270
C 
C REAL ITEM - CONVERT FROM ASCII
C 
230   CONTINUE
      VAR = 0.0 
      IF(J-I .LT. 0) GOTO 235 
      VAR = CATR(INBUF,I,J,ISTAT) 
C 
C IF ERROR OUTPUT "NON-NUMERIC VALUE IN REAL NUMBER"
C 
      IF (ISTAT.EQ.0) GOTO 235
      CALL ERIO(2,LU,ERR7,10) 
      GOTO 305
C 
C MOVE VALUE TO OUTPUT BUFFER 
C 
235   CALL SMOVE(VAR,1,4,IVALU,PP2) 
      GOTO 270
C 
C ASCII INPUT 
C 
C 
C TRUNCATE IF NECESSARY 
C 
240   CONTINUE
      IF(J-I .LT. 0) GOTO 270 
      IF(J-I.LT.LEN) GOTO 260 
C  ERROR - INPUT TOO LONG 
      CALL ERIO(2,LU,ERR4,15) 
      GOTO 305
260   CONTINUE
      CALL SMOVE(INBUF,I,J,IVALU,PP2) 
C 
C UPDATE POINTER
C 
270   CONTINUE
      PP2 = PP2 + LEN 
C 
C VERIFY THAT THERE IS A LEGAL SEPARATOR
C 
      CALL LSCAN(INBUF,I,J,K) 
      IF(K .EQ. 5) GOTO 310 
      IF(K .EQ. 4) GOTO 300 
275   CALL ERIO(2,LU,ILTERM,10) 
      GOTO 305
C 
C 
C 
300   CONTINUE
C 
C 
C 
C END OF DO LOOP
C BE SURE THE LIST ENDED WITH A SEMICOLN
C 
      IF(K .EQ. 5) GOTO 310 
      CALL ERIO(2,LU,ILTERM,10) 
C 
C DONE WITH ITEM
C 
305   IERR = -1 
310   CONTINUE
      RETURN
      END 
$ 
                                                                                            