C get5d.f
C
C
      SUBROUTINE GET5D
C     Read a non-comprssed grid file to obtain the COMMON/JTIME info
C     including grid size, parameters, time steps, etc.
C
      include "vis5d.h"
      PARAMETER (IHSIZE=64)
      CHARACTER*8 FILNAM
      CHARACTER*4 CLIT
      INTEGER ITABLE(64),IHEAD(64)
      COMMON/JTIME/NTIMES,NPARMS,MR,MC,ML,
     *   XLATN,XLONW,XHGTT,XLATIN,XLONIN,XHGTIN,
     *   JDAY(NTIME),JTIME(NTIME),JPARM(NPARM)
      COMMON/NGRID/IGRIDF,NGRIDF,NGRID(NFILE)
C
C INITIALIZE GRID POINTERS
      IF (NGRIDF .GT. NFILE) GO TO 94
      KGRIDF = IGRIDF
      LGRIDF = IGRIDF+NGRIDF-1
      IGRID=1
      ITIME=1
      IPARM=1
C
C READ FIRST GRID DIRECTORY (ACCESS CODE COPIED FROM IGPT3D)
      IF (IGOP3D(KGRIDF,FILNAM) .NE. 0) GOTO 99
      I=LWI(FILNAM,0,64,IHEAD)
      NGRIDS=IHEAD(12)
C
      IF(LWI(FILNAM,IGRID*IHSIZE,IHSIZE,ITABLE) .NE. 0) GO TO 99
      ISIZE=ITABLE(1)
      IF(ISIZE .LT. 1 .OR. ISIZE .GT. 20000000) GOTO 98
C GET GRID DESCRIPTION TO MATCH TO DATA SET
      MR=ITABLE(2)
      MC=ITABLE(3)
      ML=ITABLE(4)
      IF(MR .LT. 1) GOTO 98
C
      ITYPE=ITABLE(22)
      IF(ITYPE .NE. 1 .AND. ITYPE .NE. 4) GO TO 98
      XLATN=ITABLE(23)/10000.0
      XLONW=ITABLE(24)/10000.0
      XLATIN=ITABLE(25)/10000.0
      ILONIN=26
      IF(ITYPE .EQ. 1) ILONIN=25
      XLONIN=ITABLE(ILONIN)/10000.0
      IHTYPE=ITABLE(31)
      IF(IHTYPE .NE. 1) GO TO 98
      XHGTT=ITABLE(32)/1000.0
      XHGTIN=ITABLE(33)/1000.0
C
      XLATS=XLATN-(MR-1)*XLATIN
      XLONE=XLONW-(MC-1)*XLONIN
      XHGTB=XHGTT-(ML-1)*XHGTIN
C
C RECORD TIME AND PARAM OF FIRST GRID
      IDAYL=IDAYS(ITABLE(6))
      ITIMEL=ISECS(ITABLE(7))
      JDAY(ITIME)=IDAYL
      JTIME(ITIME)=ITIMEL
      JPARM(IPARM)=ITABLE(9)
C
C GET GRIDS IN FIRST TIME SET
10    IGRID=IGRID+1
      IF(IGRID .LE. NGRIDS) GO TO 30
20    KGRIDF = KGRIDF+1
      II = KGRIDF-IGRIDF
      NGRID(II) = IGRID-1
      IF (KGRIDF .GT. LGRIDF) GO TO 70
      IF (IGOP3D(KGRIDF,FILNAM) .NE. 0) GOTO 99
      I = LWI(FILNAM,0,64,IHEAD)
      NGRIDS = IHEAD(12)
      IGRID = 1
30    IF (LWI(FILNAM,IGRID*IHSIZE,IHSIZE,IHEAD) .NE. 0) GO TO 20
      IF (IHEAD(1) .LT. 0) GO TO 20
C
      IF (IDAYL .NE. IDAYS(IHEAD(6)) .OR.
     *   ITIMEL .NE. ISECS(IHEAD(7)) ) GO TO 100
C
C     MR, MC & ML MATCH?
      DO 40 J=2,4
40    IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
C
C      XLAT & XLON MATCH?
      DO 50 J=22,ILONIN
50    IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
C
C     XHGT MATCH?
      DO 60 J=31,33
60    IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
C
      IPARM=IPARM+1
      IF(IPARM .GT. NPARM) GO TO 93
      JPARM(IPARM)=IHEAD(9)
      GO TO 10
70    NPARMS=IPARM
      NTIMES=1
      RETURN
C
C NOW GET SUCCEEDING TIME SETS
100   NPARMS=IPARM
      CALL SCOUT('IDAYL',IDAYL,ITIMEL,IDAYS(IHEAD(6)),
     * ISECS(IHEAD(7)),0,0)
      CALL LDEST('NPARMS = ',NPARMS)
      DO 80 I=1,NPARMS
80    CALL LDEST(CLIT(JPARM(I)),I)
      IGRID=IGRID-1
110   ITIME=ITIME+1
      IF(ITIME .GT. NTIME) GO TO 92
      DO 200 IP=1,NPARMS
      IGRID=IGRID+1
      IF(IGRID .LE. NGRIDS) GO TO 130
120   KGRIDF=KGRIDF+1
      II=KGRIDF-IGRIDF
      NGRID(II)=IGRID-1
      IF(KGRIDF .GT. LGRIDF) GO TO 210
      IF (IGOP3D(KGRIDF,FILNAM) .NE. 0) GOTO 99
      I=LWI(FILNAM,0,64,IHEAD)
      NGRIDS=IHEAD(12)
      IGRID=1
130   IF(LWI(FILNAM,IGRID*IHSIZE,IHSIZE,IHEAD) .NE. 0) GO TO 120
      IF(IHEAD(1) .LE. 0) GO TO 120
C
C RECORD AND CHECK TIME
      IF(IP .GT. 1) GO TO 140
      JDAY(ITIME)=IDAYS(IHEAD(6))
      JTIME(ITIME)=ISECS(IHEAD(7))
      IF( JDAY(ITIME) .LT. JDAY(ITIME-1) .OR.
     *  (JDAY(ITIME) .EQ. JDAY(ITIME-1) .AND.
     *   JTIME(ITIME) .LE. JTIME(ITIME-1) ) ) GO TO 96
      GO TO 150
140   IF(JDAY(ITIME) .NE. IDAYS(IHEAD(6)) .OR.
     *   JTIME(ITIME) .NE. ISECS(IHEAD(7)) ) GO TO 100
C PARAMETER MATCH?
150   IF(JPARM(IP) .NE. IHEAD(9)) GO TO 95
C
C MR, MC & ML MATCH?
      DO 160 J=2,4
160   IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
C XLAT & XLON MATCH?
      DO 170 J=22,ILONIN
170   IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
C XHGT MATCH?
      DO 180 J=31,33
180   IF(IHEAD(J) .NE. ITABLE(J)) GO TO 97
200   NTIMES=ITIME
      GO TO 110
210   CONTINUE
      CALL DOUBT('JDAY',NTIMES,JDAY)
      CALL DOUBT('JTIME',NTIMES,JTIME)
      CALL DOUBT('NGRID',NFILE,NGRID)
      RETURN
C
92    CALL EDEST('TOO MANY TIME STEPS ',0)
      CALL EXIT(0)
93    CALL EDEST('TOO MANY PARAMETERS ',0)
      CALL EXIT(0)
94    CALL EDEST('TOO MANY GRID FILES ',0)
      CALL EXIT(0)
95    CALL EDEST('PARAMETERS DO NOT MATCH ',0)
      CALL SDEST(CLIT(JPARM(IP))//' '//CLIT(ITABLE(9)),IP)
      CALL SDEST('ITIME',ITIME)
      CALL EXIT(0)
96    CALL EDEST('GRID TIMES OUT OF ORDER ',0)
      CALL SCOUT('ITIME',ITIME,JDAY(ITIME),JTIME(ITIME),
     * JDAY(ITIME-1),JTIME(ITIME-1),IP)
      CALL EXIT(0)
97    CALL EDEST('GRIDS DO NOT MATCH ',0)
      CALL SCOUT('JGRIDF',JGRIDF,IGRID,NSETS,ISETD,ISET,I)
      CALL SCOUT('MR',MR,MC,ML,JGRID,KGRID,IRES)
      CALL SCOUT('KDAYL',KDAY,JDAYL,KTIMEL,JTIMEL,IGRIDF,0)
      CALL DOUBT('IHEAD',64,IHEAD)
      CALL DOUBT('ITABLE',64,ITABLE)
      CALL EXIT(0)
98    CALL EDEST('BAD GRID SIZE OR TYPE ',0)
      CALL SCOUT('ISIZE',ISIZE,MR,ITYPE,IHTYPE,MC,ML)
      CALL EXIT(0)
99    CALL EDEST('BAD GRID FILE READ ',0)
      CALL EXIT(0)
      RETURN
      END
C
C
C
C
C
      SUBROUTINE GETGRD(IT,IP,NPARMI,GRID,MRMCML)
C     Get a single 3-D grid from a grid file.  The grid file is
C     specified by the info in the COMMON/NGRID block.
C     Input:  IT - the time step of the 3-D grid.
C             IP - the parameter number of the 3-D grid.
C             NPARMI - the number of parameters in the grid file.
C             GRID - array to put the 3-D grid into.
C             MRMCML - size of the GRID array.
C     Output:  GRID - this array will be loaded with the 3-D grid data.
C
      include "vis5d.h"
C
      REAL*4 GRID(*)
C
      COMMON/JTIME/NTIMES,NPARMS,MR,MC,ML,
     *   XLATN,XLONW,XHGTT,XLATIN,XLONIN,XHGTIN,
     *   JDAY(NTIME),JTIME(NTIME),JPARM(NPARM)
C
      COMMON/NGRID/IGRIDF,NGRIDF,NGRID(NFILE)
C
      INTEGER ITAB(64)
C
      JGRID = NPARMI*(IT-1)+IP
      DO 30 IFILE=1,NGRIDF
         IF (JGRID .GT. NGRID(IFILE)) GO TO 30
         JGRIDF = IGRIDF+IFILE-1
         ISTAT = IGGT3D(JGRIDF,JGRID,MRMCML,GRID,KR,KC,KL,ITAB)
         IF (ISTAT .NE. 0) GOTO 99
         CALL SCOUT('GETGRD',IT,IP,JGRIDF,JGRID,MRMCML,IFILE)
         RETURN
30    JGRID = JGRID-NGRID(IFILE)
      CALL SDEST('GETGRD BOMB ',0)
      CALL SCOUT('SHARDS',IT,IP,JGRIDF,JGRID,NPARMI,IFILE)
      CALL EXIT(0)
99    CALL SDEST('IGGT3D FAILURE',0)
      CALL EXIT(0)
      END
