C***********************************************************************
C   THIS SUBROUTINE IS WRITTEN TO READ DATA AND SUPPLY IT TO A MAIN
C   PROGRAM. IT IS ASSUMED THAT THERE MAY BE ONE OR MORE SETS OF DATA IN
C   IN THE SAME FORMAT.
C   IT IS ASSUMED THE DATA CARDS OF A SET(SAMPLE) ARE ALL TOGETHER.
C  IT IS ASSUMED EACH CARD HAS SOME IDENTIFICATION FIELD,OR FIELDS,ON IT
C   WHICH UNIQUELY INDICATES THE DATA SET THE CARD BELONGS TO. IT IS
C   FURTHER ASSUMED THAT THE DATA ARE NUMERIC IN SOME FIXED FORMAT.THERE
C   MAY BE ONE OR MORE VARIABLES PER CARD.  THE SUBROUTINE WILL READ AND
C   STORE ONE COMPLETE DATA SET AT A TIME THEN RETURN IT TO THE MAIN
C   PROGRAM FOR PROCESSING. IT IS ASSUMED THAT CONTROL WILL THEN BE
C   RETURNED TO THE SUBROUTINE TO READ THE NEXT DATA SET.
C   THE IDENTIFICATION CHARACTERS ARE READ FIRST IN A1 FORMAT, THEN THE
C   DATA ARE READ. IT IS ASSUMED THAT THE ID FIELD MAY INVOLVE SEVERAL
C   FACTORS AND THAT IT MAY BE DESIRABLE TO POOL SOME DATA SETS OVER ONE
C   OR MORE OF THESE. TO ACHIEVE THIS A SPECIAL FEATURE EXITS. THE FIRST
C   CARD OF A DATA STREAM MAY BE A SPECIAL 'BLANK-OUT' CARD THAT WILL
C   CAUSE THE IGNORING OF ANY GIVEN CARD COLUMNS OF THE ID FIELD.
C   THUS ONE CAN 'ERASE' ALL OR PART OF THE ID FIELD ON
C    EACH CARD. IF THIS CARD IS LEFT OUT THE ENTIRE ID FIELD IS USED
C   FOR DETERMINING GROUP MEMBERSHIP.
C   NOTE  PROPER POOLING WILL ONLY OCCUR IF THE DATA SETS TO BE POOLED
C   ARE CONSECUTIVE IN THE DATA STREAM.
C   TO BLANK OUT CARD COLUMN 'I' OF THE ID FIELD JUST PUNCH A '1' IN
C   THAT CARD COLUMN OF THE SPECIAL ID FIELD DEFINITION CARD .
C   DATA ARE PLACED IN LABELED COMMON.  THE CALLING ARGUMENTS ARE IC,N,
C   HEAD. ON A FIRST CALL TO READ II MUST BE SET EQUAL TO ONE.  A FIRST
C   CALL BEING WHEN A BLANKOUT CARD IS (OR COULD BE) THE NEXT CARD IN
C   THE DATA STREAM.
C***********************************************************************
      SUBROUTINE READ (N)
C**********************************************************************
C     DECLARATIONS
C**********************************************************************
      INCLUDE 'PARMTR.INC'
      CHARACTER*1 KEY(4), TITLE(30), LABEL, HEAD, UL,
     1   BLANK, ERASE, BLK(30)
      LOGICAL ALLBLK
      REAL XHOLD(3)
      INTEGER STATUS, SYSIN, FILPOS
      LOGICAL GRP, POOL, PEST, SEST, DESC, DEF, CUTP, TRUNC, SK, HELP
C***********************************************************************
C     COMMON STATEMENTS
C***********************************************************************
      COMMON /HOLD/ XHOLD, ALLBLK
      COMMON /HOLDS/ TITLE, BLK
      COMMON /OPTION/ GRP, POOL, PEST, SEST, DESC, DEF, CUTP, TRUNC,
     1 HELP
      COMMON /MEASUR/ DATA(MAXOBJ,5)
      COMMON /ALPHA/ LABEL(80), HEAD(30), UL(3,25)
      COMMON /PAGE/ IPAGE
      COMMON /FILE/ SYSIN, SK, FILPOS
      COMMON /IND/ IC, II, IREP, STATUS
C***********************************************************************
C     DATA STATEMENTS
C***********************************************************************
      DATA BLANK /' '/, ERASE /'1'/
      DATA KEY /'E','N','D','.'/
C***********************************************************************
C   ON THE FIRST CALL TO READ, CONTROL COMES HERE. ON ALL SUBSEQUENT
C   CALLS TO READ, CONTROL JUMPS TO STATEMENT 40
C***********************************************************************
      IF (II.NE.1) GO TO 40
      READ (SYSIN,140) TITLE,XHOLD
      DO 10 I=1,30
   10 BLK(I)=BLANK
      DO 20 I=1,30
      IF ((TITLE(I).EQ.ERASE).OR.(TITLE(I).EQ.BLANK)) GO TO 20
      GO TO 40
   20 CONTINUE
      ALLBLK=.TRUE.
      DO 30 I=1,30
      IF (TITLE(I).NE.ERASE) GO TO 30
      ALLBLK=.FALSE.
      BLK(I)=ERASE
   30 CONTINUE
      IF (ALLBLK) GO TO 40
C***********************************************************************
C   IF THE FIRST CARD WAS AN ERASE CARD THE ALLBLK WILL BE FALSE
C   IF ALLBLK IS TRUE THEN THE FIRST CARD READ WAS A DATA CARD BUT THE
C   ID FIELD IS BLANK
C***********************************************************************
      READ (SYSIN,140) TITLE,XHOLD
   40 DO 50 J=1,3
   50 DATA(1,J)=XHOLD(J)
      N=1
      DO 60 I=1,30
      IF (BLK(I).EQ.ERASE) TITLE(I)=BLANK
   60 HEAD(I)=TITLE(I)
   70 READ (SYSIN,140,END=130) TITLE,XHOLD
C***********************************************************************
C     CHECK FOR END OF DATA SET MARKED BY END. .
C***********************************************************************
      DO 80 I=1,4
      IF (TITLE(I).NE.KEY(I)) GO TO 90
   80 CONTINUE
C***********************************************************************
C     IF AN END. CARD HAS BEEN FOUND SET IC=-2 AS A FLAG
C***********************************************************************
      IC=-2
      RETURN
C***********************************************************************
C     IF DATA SETS ARE TO BE POOLED THEN IGNORE THE HEADINGS ON THE CARD
C     QUIT ONLY AT THE END OF THE DATA SET
C***********************************************************************
   90 IF (POOL) GO TO 110
C***********************************************************************
C     COMPARE HEADER STATEMENTS.  IF IT IS A NEW DATA SET THEN RETURN.
C     OTHERWISE STORE THE DATA POINTS.
C***********************************************************************
      DO 100 I=1,30
      IF (BLK(I).EQ.ERASE) TITLE(I)=BLANK
      IF (HEAD(I).NE.TITLE(I)) RETURN
  100 CONTINUE
  110 N=N+1
      IF (N.GT.MAXOBJ) THEN
         WRITE(0,*) 'Number of objects exceeds dimensions.'
         STOP
      ENDIF
      DO 120 J=1,3
  120 DATA(N,J)=XHOLD(J)
      GO TO 70
C***********************************************************************
C     IF THE END OF THE FILE HAS BEEN REACHED THEN SET IC=-1 AS A FLAG
C***********************************************************************
  130 IC=-1
      RETURN
  140 FORMAT (30A1,3F5.0)
      END