CTITLE FOIASZ -- GLI FILE INFORMATION RETRIEVAL - STATICS/DATUMS
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR                 R. S. HOGARTH
CA    DESIGNER               R. S. HOGARTH
CA    LANGUAGE               VS FORTRAN (77)
CA    SYSTEM                 IBM
CA    WRITTEN                12-3-87
C     REVISED  07-19-88 TJT - MODIFY FOR NEW GLI3D STATICS FORMAT.
C     REVISED  11-02-88 TJT - ADD OPEN CALL FOR WORK FILE (FOISSD).
C     REVISED  04-13-89 TJT - CK FOR TOO MANY LINES IN LINE NAME TABLE.
C     REVISED  02-13-90 TJT - FIX RE-ENTRANT PROBLEM WITH NO2DLN/MX2DLN.
CA
CA
CA    CALL FOIASZ( KPBUGF, IPR, FSP, LSP, NSHOT, NTR, DCBAD, NO2DLN,
CA         SHOTNO, LINENM, WORK, IWORK, KPWRKS, KPWRKD, MX2DLN, IST)
CA
CA    IN/OUT  ARGUMENT  TYPE  DESCRIPTION
CA
CA    IN      KPBUGF      I   DEBUG FLAG
CA    IN      IPR         I   DEBUG UNIT
CA    IN      FSP         I   FIRST SHOT TO PROCESS IN FILE ORDER
CA    IN      LSP         I   LAST SHOT TO PROCESS IN FILE ORDER
CA    IN      NSHOT       I   NUMBER OF SHOTPOINTS
CA    IN      NTR         I   NUMBER OF TRACES PER SHOTPOINT
CA    IN      DCBAD       I   DCB ADDRESS
CA    IN      NO2DLN      I   # OF 2D LINES ALLOWED IN LINE NAME TABLE
CA                               ( SET IN SDSTAP AND JSCORE)
CA    OUT     SHOTNO      I   SHOTPOINT NUMBER/DISK ADDR LIST(UNSORTED)
CA    OUT     LINENM      I   LINE NAME TABLE.  PACKED AS LINE NAME,
CA                            FIRST SHOT POINT, ETC.
CA    OUT     WORK        I4  WORK ARRAY (2*LCTPSP+3)
CA    OUT     IWORK       I2  WORK ARRAY (2*LCTPSP+3) USED TO PACK
CA                            STATIC AND DATUM VALUES 2/WORD
CA    OUT     MX2DLN      I   # OF 2D LINES IN LINE NAME TABLE
CA    OUT     IST         I   ERROR FLAG
CA                               0 FOR NO ERROR
CA
CA    THIS SUBROUTINE READS THE GLI FILE, PACKS IT INTO AN INT*2 ARRAY,
CA    AND WRITES IT TO A DISK FILE WHICH MAY BE MEMORY RESIDENT.
CAEND
CTITLE FOIGET -- GET STATIC/DATUM FROM INT*2 ARRAY
CA    AUTHOR                 T. J. TRULOCK
CA    DESIGNER               T. J. TRULOCK
CA    LANGUAGE               VS FORTRAN (77)
CA    SYSTEM                 IBM
CA    WRITTEN                10-10-88
CA
CA
CA    CALL FOIGET( IWORK, GLORTN, GLST, GLDAT)
CA
CA    IN/OUT  ARGUMENT  TYPE  DESCRIPTION
CA
CA    IN      IWORK       I2  WORK ARRAY (2*LCTPSP+3) CONTAINS
CA                            STATIC AND DATUM VALUES 2/WORD
CA    IN      GLORTN      I4  INPUT TRACE NUMBER
CA    OUT     GLST        I4  GLI3D STATIC VALUE
CA    OUT     GLDAT       I4  GLI3D DATUM VALUE
C***********************************************************************
C
      SUBROUTINE FOIASZ(KPBUGF, IPR, FSP, LSP, NSHOT, NTR, DCBAD,NO2DLN,
     .         SHOTNO, LINENM, WORK, IWORK, KPWRKS, KPWRKD, MX2DLN, IST)
      IMPLICIT INTEGER (A-Z)
C
      INTEGER      SHOTNO(2*NSHOT)
      INTEGER      LINENM(3*NO2DLN+3)
      INTEGER      WORK  (2*NTR+3)
      INTEGER*2    IWORK (2*NTR)
      CHARACTER*8  DDNAME
C
C     SET UP TEMP. DISK FILE TO HOLD STATIC/DATUM DATA
C
      CALL UPAWRK(NSHOT, NTR*4, 'A', KPWRKS, KPWRKD, DDNAME, ERR, ERRIN)
      CALL FOISSD(KPWRKS, NTR*4)
C
C     SCAN FILE FOR SHOT NUMBER AND FILE ADDRESS
C
      MX2DLN = 0
      OLDNM1 = 0
      OLDNM2 = 0
      LNPTR  = 0
      IPTR   = 1
      SPTR   = 1
C
      DO 30 I = 1,NSHOT
         CALL FGRTR(DCBAD,WORK,LRECL,STATUS)
         IF(STATUS.NE.1)GO TO 9007
C
C--BUILD LINE NAME TABLE
C
         IF ((WORK(2).NE.OLDNM1) .OR. (WORK(3).NE.OLDNM2)) THEN
            OLDNM1 = WORK(2)
            OLDNM2 = WORK(3)
            LINENM(LNPTR*3+1) = WORK(2)
            LINENM(LNPTR*3+2) = WORK(3)
            LINENM(LNPTR*3+3) = SPTR
            LNPTR = LNPTR + 1
            IF(LNPTR .GT. NO2DLN) THEN
               WRITE(IPR, 9030) LNPTR, NO2DLN
 9030          FORMAT(///,'  *** NUMBER OF SHOTLINES INPUT=',I7,4X,
     *                'MAXIMUM ALLOWED=',I7,' *** (FOIASZ)',//)
               IST = -999
            ENDIF
         ENDIF
C
C--BUILD SHOT POINT TABLE
C
         SHOTNO(SPTR) = WORK(1)
         SHOTNO(SPTR+1) = IPTR
         SPTR = SPTR+2
C
C--WRITE STATIC/DATUM TO DISK
C
CDEBUG--------------------------------
       IF(KPBUGF .GT. 1) WRITE(IPR,*) ' SHOT#=',WORK(1)
CDEBUG--------------------------------
         DO 25 IX = 1, NTR*2
   25    IWORK(IX) = WORK(IX+3)
CDEBUG---------------------------------
       IF(KPBUGF .EQ. 2) WRITE(IPR,29) (IWORK(IX),IX=1,10)
       IF(KPBUGF .EQ. 3) WRITE(IPR,29) (IWORK(IX),IX=1,NTR*2)
   29  FORMAT(5(5X,2I5))
CDEBUG---------------------------------
         CALL FOWSSD (KPWRKS, IPTR, IWORK(1))
   30    CONTINUE
C
C          CLOSE DISK FILE / CAPTURE END POINTERS
C
      CALL FOCSD (KPWRKS)
      CALL FOIDSD (KPWRKD, NTR*4)
      LINENM(LNPTR*3+3) = SPTR
      MX2DLN = LNPTR
C
      WRITE(IPR,8001) FSP,LSP,NSHOT,NTR
 8001 FORMAT(5X,'------- GLI FILE SUMMARY ---------',
     .      /5X,'FIRST SHOTPOINT                   :',I6,
     .      /5X,'LAST SHOTPOINT                    :',I6,
     .      /5X,'NUMBER OF SHOTPOINTS              :',I6,
     .      /5X,'NUMBER OF TRACES PER SHOTPOINT    :',I6,
     .      /5X,'**********************************',//)
       IF(KPBUGF .GT. 1) WRITE(IPR,8012) (LINENM(I),I=1,LNPTR*3)
 8012 FORMAT(' LINE NAMES IN THE GLI FILE:-',/,(3X,2A4,I6))
       IF(KPBUGF .GT. 1) WRITE(IPR,8002) (SHOTNO(I),I=1,SPTR-1)
 8002 FORMAT(' SHOT NUMBERS/DISK ADDR. FOR THE GLI FILE:-',/,(10I8))
 8999 CONTINUE
C
      RETURN
C
 9007 CONTINUE
      IST = 7
      WRITE(IPR,9107) I,STATUS
 9107 FORMAT(5X,'*** ERROR FOIASZ. READ ERROR, REC=',I5,
     .      /5X,'*** STATUS FLAG:-',Z9)
      GO TO 8999
C-----
      ENTRY  FOIGET (IWORK, GLORTN, GLST, GLDAT)
C-----
      I = GLORTN * 2 - 1
      GLST  = IWORK(I)
      GLDAT = IWORK(I+1)
      RETURN
      END