c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE PAKREAD                    ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c

      SUBROUTINE pakread(nx,ny,nz, grdbas, inch, time, x,y,z,zp,
     :           uprt, vprt, wprt, ptprt, pprt, 
     :           qvprt, qc, qr, qi, qs, qh, km, 
     :           ubar, vbar, wbar, ptbar, pbar, rhobar, qvbar,
     :           ireturn, intem )

c
c#######################################################################
c
c     PURPOSE:
c
c     Read in data field from packed binary dataset created by ARPS 3.0
c
c     All data read in are located at the grid cell centers.  Variables 
c     u, v and w were averaged to the cell center before being dumped. 
c
c#######################################################################
c
c     AUTHOR: Keith Brewster
c     7/14/92.    
c
c     MODIFICATION HISTORY:
C
c#######################################################################
c
c     INPUT : 
c
c       nx       Number of grid points in the x-direction (east/west)
c       ny       Number of grid points in the y-direction (north/south)
c       nz       Number of grid points in the vertical
c
c       grdbas   Data read mode flag. 
c                If grdbas=1, only grid and base state arrays will be read 
c                If grdbas=0, all arrays will be read based on data 
c                             parameter setting.  
c       inch     Channel number for binary reading.
c                This channel must be opened for unformatted reading
c                by the calling routine.
c
c     OUTPUT:
c
c       time     Time in seconds of data read from "filename"
c
c       x        x coordinate of grid points in physical/comp. space (km)
c       y        y coordinate of grid points in physical/comp. space (km)
c       z        z coordinate of grid points in computational space (km)
c       zp       z coordinate of grid points in physical space (km)
c
c       uprt     x component of perturbation velocity (m/s)
c       vprt     y component of perturbation velocity (m/s)
c       wprt     Vertical component of perturbation velocity in Cartesian 
c                coordinates (m/s).
c       ptprt    Perturbation potential temperature (K)
c       pprt     Perturbation pressure (Pascal)
c       u        x component of velocity (m/s)
c       v        y component of velocity (m/s)
c       w        Vertical component of velocity in Cartesian 
c                coordinates (m/s).
c
c       pt       Potential temperature (K)
c       pprt     Perturbation pressure (Pascal)
c
c       qvprt    Perturbation water vapor mixing ratio (kg/kg)
c       qc       Cloud water mixing ratio (kg/kg)
c       qr       Rainwater mixing ratio (kg/kg)
c       qi       Cloud ice mixing ratio (kg/kg)
c       qs       Snow mixing ratio (kg/kg)
c       qh       Hail mixing ratio (kg/kg)
c
c       km       Turbulent mixing coefficient (m**2/s)
c
c       ubar     Base state x velocity component (m/s)
c       vbar     Base state y velocity component (m/s)
c       wbar     Base state z velocity component (m/s)
c       ptbar    Base state potential temperature (K)
c       pbar     Base state pressure (Pascal)
c       rhobar   Base state air density (kg/m**3)
c       qvbar    Base state water vapor mixing ratio (kg/kg)
c
c       ireturn  Return status indicator
c                ireturn=0   successful read of all data
c                ireturn=1   error reading data
c                ireturn=2   end-of-file reached during read attempt
c
c       WORK ARRAY:
c
c       intem    Integer work array
c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none 
c
      integer nx,ny,nz
c
      real x     (nx,ny,nz)     
      real y     (nx,ny,nz)    
      real z     (nx,ny,nz)   
      real zp    (nx,ny,nz)     
c
      integer grdbas
      integer inch
      real time
c
      real uprt  (nx,ny,nz)     ! Perturbation u-velocity (m/s)
      real vprt  (nx,ny,nz)     ! Perturbation v-velocity (m/s)
      real wprt  (nx,ny,nz)     ! Perturbation w-velocity (m/s)
      real ptprt (nx,ny,nz)     ! Perturbation potential temperature (K)
      real pprt  (nx,ny,nz)     ! Perturbation pressure (Pascal)
c
      real qvprt (nx,ny,nz)     ! Perturbation water vapor mixing ratio (kg/kg)
      real qc    (nx,ny,nz)     ! Cloud water mixing ratio (kg/kg)
      real qr    (nx,ny,nz)     ! Rain water mixing ratio (kg/kg)
      real qi    (nx,ny,nz)     ! Cloud ice mixing ratio (kg/kg)
      real qs    (nx,ny,nz)     ! Snow mixing ratio (kg/kg)
      real qh    (nx,ny,nz)     ! Hail mixing ratio (kg/kg)
      real km    (nx,ny,nz)     ! Turbulent mixing coefficient
c
      real ubar  (nx,ny,nz)     ! Base state u-velocity (m/s)
      real vbar  (nx,ny,nz)     ! Base state v-velocity (m/s)
      real wbar  (nx,ny,nz)     ! Base state w-velocity (m/s)
      real ptbar (nx,ny,nz)     ! Base state potential temperature (K)
      real pbar  (nx,ny,nz)     ! Base state pressure (Pascal).
      real rhobar(nx,ny,nz)     ! Base state air density (kg/m**3)
      real qvbar (nx,ny,nz)     ! Base state water vapor mixing ratio

      integer ireturn

      integer intem(nx*ny*nz)     ! integer work array
c
c#######################################################################
c
c     Parameters describing routine that wrote the gridded data
c
c#######################################################################
c
      character*40 fmtver,fmtverin
      character*10 tmunit
c
c#######################################################################
c
c     Unpacking variables
c
c#######################################################################
c
      integer iscale,nbits
      real amin,amax,ref
c
c#######################################################################
c
c     Misc. local variables
c
c#######################################################################
c
      integer lchanl
      parameter (lchanl=6)                    ! listing unit number
      integer ihdlen,lablen
      parameter (ihdlen=5000, lablen=40)
      integer ihead(ihdlen)
      integer label(lablen)
      character*12 chlabel
c
      integer i,ilen,illen,nxyz,iend
      integer knt,kntscal
      integer kntin,kntsclin
      integer nxin,nyin,nzin
      integer bgrdin, bbasin, bvarin, bmstin, bicein, btrbin
c
c#######################################################################
c
c     Include files: 
c
c#######################################################################
c
      include 'indtflg.inc'
      include 'globcst.inc'
c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
      external kntary
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      nxyz=nx*ny*nz
c
c#######################################################################
c
c     Establish the expected array count based on the switch settings
c
c#######################################################################
c
c
c#######################################################################
c
c     Read header info
c
c#######################################################################
c
      read(inch,err=110,end=120) ihead

      IF( grdbas.eq.1 ) THEN ! Read grid and base state arrays

        CALL decdhdr(nxin,nyin,nzin,ihdlen,ihead,ilen,time,
     :               bgrdin,bbasin,bvarin,bmstin,bicein,btrbin,
     :               fmtverin,tmunit,kntin,kntsclin)

        write(6,'(//''  The name of this run is:  '',a//)') runname
        write(lchanl,'(1x,a,f8.1,a,f8.3,a/)')
     :       'To read grid and base state data at time ', time,
     :       ' secs = ',(time/60.),' mins.'

        CALL kntary(fmtver,bgrdin,bbasin,bvarin,bmstin,bicein,btrbin,
     :              knt,kntscal)


      ELSE ! Normal data reading

        CALL decdhdr(nxin,nyin,nzin,ihdlen,ihead,ilen,time,
     :               grdin,basin,varin,mstin,icein,trbin,
     :               fmtverin,tmunit,kntin,kntsclin)

        write(6,'(//''  The name of this run is:  '',a//)') runname
        write(lchanl,'(1x,a,f8.1,a,f8.3,a/)')'To read data for time:',
     :       time,' secs = ',(time/60.),' mins.'

        CALL kntary(fmtver,grdin,basin,varin,mstin,icein,trbin,
     :              knt,kntscal)

      ENDIF
c
C#######################################################################
c
c     Get dimensions of data in binary file and check against
c     the dimensions passed to BINREAD
c
C#######################################################################
c
      IF( nxin.ne.nx .or. nyin.ne.ny .or. nzin.ne.nz ) THEN 
        write(6,'(1x,a)') 
     :       ' Dimensions in PAKREAD inconsistent with data.'
        write(6,'(1x,a,3I15)') ' Read were: ', nxin, nyin, nzin
        write(6,'(1x,a)') 
     :       ' Program aborted in PAKREAD.'
        STOP
      ENDIF
      iend= (nxyz+1)/2
c
C#######################################################################
c
c     Read in x,y and z at grid cell centers (scalar points).
c
C######################################################################
c
      IF( grdin.eq.1 .or. grdbas.eq.1 ) THEN

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem, x, amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' x.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,y,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' y.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,z,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' z.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,zp,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' zp.'

      ENDIF  ! grdin
c
C#######################################################################
c
c     Read in base state fields
c
C######################################################################
c
      IF( basin.eq.1 .or. grdbas.eq.1 ) THEN 

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,ubar,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' ubar.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,vbar,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' vbar.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,wbar,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' wbar.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,ptbar,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' ptbar.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,pbar,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' pbar.'


        IF( mstin.eq.1) THEN 
          read(inch,err=110,end=120) label
          read(inch,err=110,end=120) (intem(i),i=1,iend)

          CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
          CALL unpkdat(nxyz,iend,intem,qvbar,amin,amax,ref,iscale,nbits)
          write(lchanl,910) chlabel,' qvbar.'
        ENDIF

      ENDIF

      IF( grdbas.eq.1 ) GOTO 930 

      IF( varin.eq.1 ) THEN
c
C#######################################################################
c
c     Read in u,v and w averaged to grid cell centers (scalar points).
c
C######################################################################
c
        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,uprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' uprt.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,vprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' vprt.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,wprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' wprt.'
c
C#######################################################################
c
c     Read in scalars
c
C######################################################################
c
        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,ptprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' ptprt.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,pprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' pprt.'

      ENDIF
c
C#######################################################################
c
c     Read in moisture variables
c
C######################################################################
c
      IF( mstin .eq.1 ) THEN

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,qvprt,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' qvprt.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,qc,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' qc.'

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,qr,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' qr.'

        IF( icein.eq.1 ) THEN 

          read(inch,err=110,end=120) label
          read(inch,err=110,end=120) (intem(i),i=1,iend)

          CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
          CALL unpkdat(nxyz,iend,intem,qi,amin,amax,ref,iscale,nbits)
          write(lchanl,910) chlabel,' qi.'

          read(inch,err=110,end=120) label
          read(inch,err=110,end=120) (intem(i),i=1,iend)

          CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
          CALL unpkdat(nxyz,iend,intem,qs,amin,amax,ref,iscale,nbits)
          write(lchanl,910) chlabel,' qs.'

          read(inch,err=110,end=120) label
          read(inch,err=110,end=120) (intem(i),i=1,iend)

          CALL dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
          CALL unpkdat(nxyz,iend,intem,qh,amin,amax,ref,iscale,nbits)
          write(lchanl,910) chlabel,' qh.'

        ENDIF
      ENDIF

      IF( trbin.eq.1 ) THEN

        read(inch,err=110,end=120) label
        read(inch,err=110,end=120) (intem(i),i=1,iend)

        CALL dcdlabel(lablen,illen,label,
     :             amin,amax,ref,iscale,nbits,chlabel)
        CALL unpkdat(nxyz,iend,intem,km,amin,amax,ref,iscale,nbits)
        write(lchanl,910) chlabel,' km.'

      ENDIF

910   FORMAT(1x,'Field ',a12,' was read into array',a)

c
C#######################################################################
c
c     Friendly exit message
c
C######################################################################
c
930   CONTINUE

      write(6,'(/a,F8.1,a/)')
     : ' Data at time=', time/60,' (min) were successfully read.'

      ireturn = 0 
      RETURN
c
C#######################################################################
c
c     Destination for error during read
c
C######################################################################
c

110   CONTINUE
      write(6,'(/a/)') ' Error reading data in PAKREAD'
      ireturn=1
      RETURN
c
C#######################################################################
c
c     Destination for end-of-file during read
c
C######################################################################
c

120   CONTINUE
      write(6,'(/a/)') ' End of file reached in PAKREAD'
      ireturn=2
      RETURN
      END     
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE UNPKDAT                    ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c
      SUBROUTINE UNPKDAT(nxyz,iend,ivect,a,amin,amax,ref,iscale,nbits)
c
c#######################################################################
c
c     PURPOSE:
c
c     Unpacks integer vector, ivect into real data vector, "a" 
c
c#######################################################################
c
c     AUTHOR: Keith Brewster, based loosely on by Rich Carpenter's
c                             subroutine READ1G
c     6/25/92.    
c
c     MODIFICATION HISTORY:
c
c#######################################################################
c
c     INPUT:
c
c       nxyz     Length of data vector
c
c       ivect    Packed data vector
c
c       amax     Maximum value within vector a
c       amin     Minimum value within vector a
c       ref      Reference (mid-point) value used for packing
c
c       iscale   Scaling constant i2=(a-ref)*2**(-iscale)
c
c       nbits    Number of bits in the output integer
c
c     OUTPUT:
c
c       a        Real data vector
c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
c
      integer nxyz
c
      integer iend
      integer ivect(nxyz)
      real a(nxyz)
c
      real amax
      real amin
      real ref
c
      integer iscale
      integer nbits
c
c#######################################################################
c
c     Misc. Local Variables
c
c#######################################################################
c
      integer kbits
      parameter (kbits=16)
      integer ishift,isgnmk
      parameter (ishift=2**(kbits),
     :           isgnmk=2**(kbits-1))
      integer i,k
      integer irec,int1,int2,isgn2
      real factor
      real rmin,rmax
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
c#######################################################################
c
c     Set scale parameters
c
c#######################################################################
c
      IF(nbits.NE.kbits) THEN
        write(6,'(1x,/a,/a)') 
     :            'Read-in data bit length incompatible with',
     :            '   data unpacker.  Program stops in UNPKDAT.'
        write(6,'(1x,a,i4,a,i4)') '  Read in: ',nbits,
     :                            '  UNPKDAT expected: ',kbits
        STOP
      ENDIF
      factor=2.0**(iscale)
c
c#######################################################################
c
c     Un-Scale the data and transfer to real array
c
c#######################################################################
c
      DO 20 i=2,nxyz,2
        k=i/2
        irec=ivect(k)/ishift
        int1=irec*ishift
        a(i-1) = factor * irec
c
        int2=abs(ivect(k)) - abs(int1)
        isgn2=int2/isgnmk
        int2=int2-(isgn2*isgnmk)
        irec=(1-2*isgn2)*int2
        a(i) = factor * irec
 20   CONTINUE
c
c#######################################################################
c
c     Get the last element if nxyz is odd
c
c#######################################################################
c
      IF( k.LT.iend ) THEN
        irec=ivect(iend)/ishift
        int1=irec*ishift
        a(nxyz) = factor * irec
      ENDIF
c
c#######################################################################
c
c     Add-back the reference
c
c#######################################################################
c
      DO 30 i=1,nxyz
        a(i) = ref + a(i)
 30   CONTINUE
c
c#######################################################################
c
c     Find the max and min as a safety check
c
c#######################################################################
c
      rmin=9.e15
      rmax=-9.e15
      DO 40 i=1,nxyz
        rmin = amin1(rmin,a(i))
        rmax = amax1(rmax,a(i))
 40   CONTINUE
c     print *, ' amin= ',amin,'    amax= ',amax
c     print *, ' rmin= ',rmin,'    rmax= ',rmax
c
      RETURN
      END
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE DECDHDR                    ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c
      SUBROUTINE decdhdr(nxin,nyin,nzin,ihdlen,ihead,ilen,time,
     :             grdin,basin,varin,mstin,icein,trbin,
     :             fmtver,tmunit,kntin,kntsclin)
c
c#######################################################################
c
c     PURPOSE:
c
c     Decodes information stored in integer array ihead, which is read
c     from an ARPS packed-format file by PAKREAD.
c
c#######################################################################
c
c     AUTHOR: Keith Brewster
c     7/25/92.    
c
c     MODIFICATION HISTORY:
c
c#######################################################################
c
c     INPUT : 
c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
      integer nxin,nyin,nzin
      integer ihdlen,ilen
      real time
      integer grdin,basin,varin,mstin,icein,trbin
      character*40 fmtver
      character*10 tmunit
      integer kntin,kntsclin
      integer ihead(ihdlen)
c
c#######################################################################
c
c     Include files: 
c
c#######################################################################
c
      include 'globcst.inc'
c
c#######################################################################
c
c     Misc. Local Variables
c
c#######################################################################
c
      integer iclen,jlen,i,l
c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
      external dcdchar
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      ilen=len(fmtver)
      CALL dcdchar(ihead,1,ilen,fmtver)
      jlen=len(runname)
      CALL dcdchar(ihead,(ilen+1),jlen,runname)
      ilen=ilen+jlen
      nocmnt = ihead(ilen+1)
      ilen=ilen+1
      jlen=len(cmnt(1))
      IF( nocmnt.gt.0 ) THEN
        iclen=ilen
        DO 10 l=1,nocmnt
          CALL dcdchar(ihead,(iclen+1),jlen,cmnt(l))
          iclen=iclen+jlen
 10     CONTINUE
      ENDIF
      ilen=ilen+(50*jlen)
      time = float(ihead(ilen+1))
      ilen=ilen+1
      jlen=len(tmunit)
      CALL dcdchar(ihead,(ilen+1),jlen,tmunit)

      ilen=ilen+jlen
      grdin    = ihead(ilen+1)
      basin    = ihead(ilen+2)
      varin    = ihead(ilen+3)
      mstin    = ihead(ilen+4)
      icein    = ihead(ilen+5)
      trbin    = ihead(ilen+6)

      kntin    = ihead(ilen+7)
      kntsclin = ihead(ilen+8)
      nxin     = ihead(ilen+9)
      nyin     = ihead(ilen+10)
      nzin     = ihead(ilen+11)
      ilen=ilen+11

      RETURN
      END
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE DCDLABEL                   ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c
      SUBROUTINE dcdlabel(lablen,illen,label,
     :               amin,amax,ref,iscale,nbits,chlabel)
c
c#######################################################################
c
c     PURPOSE:
c
c     Decodes information stored in integer array label, which is read
c     from an ARPS packed-format file by PAKREAD.  The label information
c     describes the data field that follows the label vector in the file.
c
c#######################################################################
c
c     AUTHOR: Keith Brewster
c     7/25/92.    
c
c     MODIFICATION HISTORY:
c
c#######################################################################
c
c     INPUT : 
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
      integer lablen,illen
      character*12 chlabel
      real amin,amax,ref
      integer iscale,nbits
      integer label(lablen)
c
c#######################################################################
c
c     Misc. Local Variables
c
c#######################################################################
c
      integer ilen
c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
      external dcdchar
      external dcdreal
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      ilen=len(chlabel)
      CALL dcdchar(label,1,ilen,chlabel)
      CALL dcdreal(label(ilen+1),label(ilen+2),amin)
      CALL dcdreal(label(ilen+3),label(ilen+4),amax)
      CALL dcdreal(label(ilen+5),label(ilen+6),ref)
      iscale = label(ilen+7)
      nbits  = label(ilen+8)
      ilen=ilen+8
c
      RETURN
      END
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE DCDCHAR                    ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c
      SUBROUTINE dcdchar(ivect,istrt,ilen,string)
c
c#######################################################################
c
c     PURPOSE:
c
c     Decodes an integer vector which describes a character string
c     within the header and label fields of an ARPS packed-format
c     data file.  The integers simply represent the ASCII number of
c     the character.
c
c#######################################################################
c
c     AUTHOR: Keith Brewster
c     7/25/92.    
c
c     MODIFICATION HISTORY:
c
c#######################################################################
c
c     INPUT : 
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
      integer istrt,ilen
      character*1 string(ilen)
      integer ivect(*)
c
c#######################################################################
c
c     Misc. Local Variables
c
c#######################################################################
c
      integer i,ism1,iloc
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      ism1=istrt-1
      DO 100 i=1,ilen
        iloc=ism1 + i
        string(i)=char(ivect(iloc))
 100  CONTINUE
      RETURN
      END
c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE DCDREAL                    ######
c     ######                                                      ######
c     ######                Copyright (c) 1992                    ######
c     ######  Center for the Analysis and Prediction of Storms    ######
c     ######    University of Oklahoma.  All rights reserved.     ######
c     ######                                                      ######
c     ##################################################################
c     ##################################################################
c
      SUBROUTINE dcdreal(int1,int2,rvar)
c
c#######################################################################
c
c     PURPOSE:
c
c     Recover a real number which has been stored as a sequence of
c     two integers, an exponent (int1) and a mantissa (int2).
c
c#######################################################################
c
c     AUTHOR: Keith Brewster
c     7/25/92.    
c
c     MODIFICATION HISTORY:
C
c#######################################################################
c
c     INPUT : 
c
c     int1         Integer describing the real number's exponent
c     int2         Integer describing the real number's mantissa
c
c     OUTPUT : 
c
c     rvar        Real number
c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
      integer int1,int2
      real rvar
c
c#######################################################################
c
c     Misc. Local Variables
c
c#######################################################################
c
      real factor
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      factor=2.0**(int1)
      rvar=factor*float(int2)
      RETURN
      END
