
C########################################################################### 
   
      SUBROUTINE INDATA
     *(FILE,NSTAT,NPHAS,NHEAD,NRECORD,TYPE,EXP,DATA,ID)
C
C   ROUTINE READS ONE EVENT IN NORDIC FORMAT INTO TEXT
C   ARRAY DATA. FILE IS OPENED OUTSIDE ROUTINE  AND IT IS
C   ASSUMED THAT NEXT RECORD TO READ IS A HEADER.
C
c   FIRST VERSION FROM AROUND 1984
C
C
c   updates:
c   1990-01-30, R.N.ARVIDSSON TO FIT PC-DOS.
c   apr 4 91 by j.h. : GIVE OUT NUMBER OF PHASES AND STATIONS
C   NOV 23 91        : CHANGE TO NEW NORDIC FORMAT, SOME CLEAN UP
c   jan 16 92        : do not count phasses and stations weighted out
C   AUG 28 92        : MAKE SURE LAST LINE IS 80 CHARS BLANK
c   jul    93 by jh  : version 3.0
c   nov 12 93        : count number of stations taking into account that
c                      stations might not follow each other in file
C!JAB(BGS)Nov94      : install error handling.
c   feb 7     jh     : fix up blank line handling a bit, no message,
c                      check for ctl z in file on PC
c   dec 14, 95       : check for array dimension in data
c   dec 7   97 jh    : count phases and stations correctly in case of weight
c                      4 and 9
c   sep 98, jh       : ------ version 7.0 check: year 2000, 5 char station
c   october 29,99 jh : nhead not defined if only header lines and no blank 
c                      line at end
c
C   INPUT :   FILE: FILE NUMBER TO READ FROM
c             nrecord: if -1, always read to end of file
C
C   OUTPUT:   NSTAT:   NUMBER OF STATIONS
C             NPHAS:   NUMBER OF PHASES FOR EVENT
C             NHEAD:   NUMBER OF HEADER RECORDS
C             NRECORD: TOTAL NUMBER OF RECORDS FOR EVENT INCLUDING LAST
C                      BLANK, IF ZERO, END OF FILE IS HIT
C             TYPE:    EVENT TYPE (D,R OR L)
C             EXP:     E FOR EXPLOSION
C             DATA:    EVENT RECORDS
C             ID:      RECORD NUMBER FOR ID LINE, 0: NO ID LINE
C
C    NOTE*** nphas and nstat are not counted for weighted out phases
c
      IMPLICIT NONE
      include 'seidim.inc'
C---TYPE OF LINE
      CHARACTER*1 LINE_TYPE  
C---SEE ABOVE  
      CHARACTER*1 TYPE,EXP
C---STATION CODES 
      CHARACTER*5 OLDSTA,NEWSTA
C---DATA AND A BLANK LINE 
      CHARACTER*80 DATA(*),BLANK
C---LOGICAL FILE NUMBER FOR READ 
      INTEGER FILE
C---SEE ABOVE  
      INTEGER NPHAS,NRECORD,NHEAD,NSTAT,ID
c-- endof line read or not
      logical end_of_file,test
C---HELP VARIABLE
      INTEGER IERR,i       
C
C    Seisan library inserts and routines...
C    ======================================
C
       include  'libsei.inc'               ! Library definitions & data defns.
       external  sei code                  ! Error encoder.
       integer   code                      ! local condition
       logical   b_eof                     ! Flag end of file.
C
C    ============= end of list ==========
C
c
c   check if read should be done to end of file, this is
c   an option used if it is known that only one event is available
c   and can be used to avoid problems if an extra blank line is present
c
      end_of_file=.false.
      if(nrecord.eq.-1) end_of_file=.true.
c
      do i=1,80
        blank(i:i)=' '
      enddo
c
      NRECORD=1
      IERR=0
      ID=0
      NSTAT=0
      nphas=0
      OLDSTA='****'
C
C   READ FIRST HEADER, ALSO BACK HERE IF FIRST LINE IS BLANK
C
 150  CONTINUE
      READ(FILE,'(A80)',iostat=code) DATA(1)
      call sei code( fort$,                      ! Stop on error.
     &               code,                       ! Condition.
     &               file,                       ! File with condition.
     &               b_eof )                     ! Flag end of file.
      if( b_eof ) goto 9999                      ! Return to caller.
C
      do i=1,80
        if(ichar(data(1)(i:i)).eq.26) goto 150  ! skip ctl z
      enddo
      IF(DATA(1).EQ.BLANK) THEN
         WRITE(6,*)'**********  BLANK HEADER LINE ***************'
         IERR=1
         GO TO 150
      ENDIF
      READ(DATA(1),'(21X,2A1,56X,A1)') TYPE,EXP,LINE_TYPE
      IF(IERR.EQ.1) THEN
C
C     WRITE DATE ETC BEFORE BLANK HEADER LINE
C
         WRITE(6,'(A80)') DATA(1)
         IERR=0
      ENDIF
C
C   LOOP FOR READING HEADERS
C
 1    CONTINUE
         NRECORD=NRECORD+1 
         if(nrecord.gt.max_data) then
            write(6,*) ' Data dimension max_data exeded, is now ',
     *      max_data
            write(6,*) ' Can be changed in seidim.inc'
            stop
         endif
 111     continue                                   ! from just below
         READ(FILE,'(A80)',IOSTAT=CODE) DATA(NRECORD)
         call sei code( fort$,                      ! Stop on error.
     &                  code,                       ! Condition.
     &                  file,                       ! File with condition.
     &                  b_eof )                     ! End of file?.
         if( b_eof ) then
             nhead=nrecord                          ! will add blank line
             goto 3                         
         endif
C
         do i=1,80
           if(ichar(data(nrecord)(i:i)).eq.26) goto 111  ! skip ctl z
         enddo
         READ(DATA(NRECORD),'(79X,A1)') LINE_TYPE   
C
C   CHECK FOR ID LINE
C
         IF(DATA(NRECORD)(80:80).EQ.'I') ID=NRECORD
C
C   CHECK IF MORE HEADERS
C
         IF(LINE_TYPE.NE.' '.AND.LINE_TYPE.NE.'4') THEN
            GO TO 1
         ENDIF
         NHEAD=NRECORD-1
C
C   READ PHASE RECORDS UNTIL BLANK LINE OR END OF FILE
c   always to eof if flag set, used with single events to trap
c   blank lines
C
 2    CONTINUE
      IF(DATA(NRECORD)(1:40).EQ.BLANK(1:40)) then 
         if(end_of_file) then
c
c   check if last line, then ok
c
            READ(FILE,'(A80)',IOSTAT=CODE) DATA(NRECORD)
            call sei code( fort$,                   ! Stop on error.
     &                     code,                    ! Condition.
     &                     file,                    ! File with condition.
     &                     b_eof )                  ! End of file?.
            if( b_eof ) goto 3                      ! & skip
C
c            write(6,*) ' Blank line in file, check !!'
c            goto 10
             goto 3
         else
            goto 3
         endif
      endif
 10   continue
c
c   if phase is weighted out, phase and station is not counted
c
      if(data(nrecord)(15:15).ne.'4'.and.data(nrecord)(15:15).ne.'9') 
     *then  
C
C   COUNT AZIMUTH AS A PHASE
C
         if(data(nrecord)(47:51).ne.'     ') nphas=nphas+1  
C
C  COUNT PHASES
C
         if(data(nrecord)(11:13).ne.'   ') nphas=nphas+1    
c
c   count stations, check all previous stations
c
         newsta=data(nrecord)(2:6)
         test=.false.
         do i=nhead+1,nrecord-1
           if(newsta.eq.data(i)(2:6).
     *     and.data(i)(15:15).ne.'4'.and.data(i)(15:15).ne.'9') 
     *     test=.true.
         enddo
         if(.not.test) nstat=nstat+1
      endif
c
c   position at next record
c
      nrecord=nrecord+1 
         if(nrecord.gt.max_data) then
            write(6,*) ' Data dimension max_data exeded, is now ',
     *      max_data
            write(6,*) ' Can be changed in seidim.inc'
            stop
         endif

 777  continue                                ! from just below
      READ(FILE,'(A80)',IOSTAT=CODE) DATA(NRECORD)
      call sei code( fort$,                   ! Stop on error.
     &               code,                    ! Condition.
     &               file,                    ! File with condition.
     &               b_eof )                  ! End of file?.
      if( b_eof ) then                        ! & skip.
         goto 3                                  ! 
      else                                    ! Otherwise.
         if(ichar(data(nrecord)(1:1)).eq.26) goto 777  ! skip ctl z
         GO TO 2                              ! Next to check.
      end if                                  !
C
C   END OF DATA FOR ONE EVENT
C
 3    CONTINUE
C
C   MAKE SURE LAST RECORD REALLY IS BLANK, COULD BE  ANYTHING IF
C   LAST LINE IF FILE WAS NOT 80 CHARS OR NOT BLANK
C
      DATA(NRECORD)=BLANK
      RETURN
C
C   END OF FILE
C
9999  NRECORD=0
      RETURN
      END
