C-----------------------------------------------------------------------

C                          RDFLDS.FOR
C                READ GULF MESOSCALE 33X33 FIELDS 
C                 (FOR 1 CYCLE STARTING AT IREC)

C-----------------------------------------------------------------------

      CHARACTER*4 AFLD
      CHARACTER*50 ALBL
      CHARACTER*1 PDAT(1089)
C**FIELDS
      DIMENSION PRES(33,33),PREC(33,33)
      DIMENSION U(33,33,9),V(33,33,9),T(33,33,9),Q(33,33,9)
      
C**OPEN MET DATA FILE
      OPEN(10,FILE=' ',FORM='BINARY',RECL=1139,ACCESS='DIRECT')
      
C**START RECORD 
      WRITE(*,*)
      WRITE(*,'(1X,''CYCLE START RECORD NUMBER'')')
      READ(*,*) IREC
C**INITIALIZE START RECORD
      IREC=IREC-1
                  
C**READ 2 SURFACE FIELDS
      DO 10 IFLD=1,2
      IREC=IREC+1
      READ(10,REC=IREC,END=99) ALBL,PDAT
      READ(ALBL,'(7I2.2,A4,I4,2E14.7)')
     : IYR,IMN,IDY,IHR,IFHR,ILVL,NGRID,AFLD,NEXP,PRECSN,VAR1
C**UNPACK
      GOTO(11,12) IFLD
   11 CALL UNPACK(PRES(1,1),PDAT,33,33,33*33,NEXP,VAR1)
      GO TO 10
   12 CALL UNPACK(PREC(1,1),PDAT,33,33,33*33,NEXP,VAR1)
   10 CONTINUE
      
C**READ 9 LEVELS
      DO 30 L=1,9
      
C**READ 4 FIELDS (PER LEVEL)           
      DO 20 IFLD=1,4
      IREC=IREC+1
      READ(10,REC=IREC) ALBL,PDAT
      READ(ALBL,'(7I2.2,A4,I4,2E14.7)')
     : IYR,IMN,IDY,IHR,IFHR,ILVL,NGRID,AFLD,NEXP,PRECSN,VAR1
C**UNPACK
      GOTO(21,22,23,24) IFLD                  
   21 CALL UNPACK(U(1,1,L),PDAT,33,33,33*33,NEXP,VAR1)
      GO TO 30 
   22 CALL UNPACK(V(1,1,L),PDAT,33,33,33*33,NEXP,VAR1)
      GO TO 30 
   23 CALL UNPACK(T(1,1,L),PDAT,33,33,33*33,NEXP,VAR1)
      GO TO 30 
   24 CALL UNPACK(Q(1,1,L),PDAT,33,33,33*33,NEXP,VAR1)
   20 CONTINUE
   
   30 CONTINUE
 
   99 STOP
      END
C-----------------------------------------------------------------------
      SUBROUTINE UNPACK(QVAR,QPACK,NX,NY,NXY,NEXP,VAR1)
      CHARACTER*1 QPACK(NXY)
      REAL*4 QVAR(NX,NY)
      SCALE=2.0**(7-NEXP)
      QOLD=VAR1
      INDX=0
      DO 400 J=1,NY
         DO 300 I=1,NX
            INDX=INDX+1
            QVAR(I,J)=(ICHAR(QPACK(INDX))-127.)/SCALE+QOLD
            QOLD=QVAR(I,J)
  300   CONTINUE
        QOLD=QVAR(1,J)
  400 CONTINUE
      RETURN
      END