c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE A3DMAX0                    ######
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 A3DMAX0(a,m1,m2,i1,i2,n1,n2,j1,j2,l1,l2,k1,k2,
     :           amax,amin)
c
c#######################################################################
c
c     PURPOSE:
c
C     Find the maximum and minimum of a 3-D array A in a specified subdomain.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     10/01/91.   
c
c     MODIFICATION HISTORY:
c
c     5/06/92 (M. Xue)
c     Added full documentation.
C
c#######################################################################
c
c     INPUT :
c
c       a        A 3-D array whose max. and min. values is sought here.
c
c       m1,m2    The dimension bounds of the first  index of array a.
c       i1,i2    The bounds of 1st index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c       n1,n2    The dimension bounds of the second index of array a.
c       j1,j2    The bounds of 2nd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c       l1,l2    The dimension bounds of the third  index of array a.
c       k1,k2    The bounds of 3rd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c
c     OUTPUT:
c
c       amax     The maximum value of array a in a specified subdomain.
c       amin     The minimum value of array a in a specified subdomain.
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none 

      integer m1,n1,l1,m2,n2,l2
      real    a(m1:m2,n1:n2,l1:l2)

      real amin, amax
c
c#######################################################################
c
c     Misc. local variables: 
c
c#######################################################################
c
      integer i1,i2,j1,j2,k1,k2,i,j,k
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c


      amax=a(i1,j1,k1)

      DO 10 k=k1,k2
      DO 10 j=j1,j2
      DO 10 i=i1,i2
        amax = max(amax, a(i,j,k))
 10   CONTINUE

      amin=a(i1,j1,k1)

      DO 20 k=k1,k2
      DO 20 j=j1,j2
      DO 20 i=i1,i2
        amin = min(amin, a(i,j,k))
 20   CONTINUE

      RETURN
      END
c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE A3DMAX                     ######
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 A3DMAX(a,m1,m2,i1,i2,n1,n2,j1,j2,l1,l2,k1,k2,
     :           amax,amin,imax,jmax,kmax, imin,jmin,kmin)
c
c#######################################################################
c
c     PURPOSE:
c
C     Find the maximum and minimum of an array A and their index locations
c     in a specified subdomain.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     10/01/91.   
c
c     MODIFICATION HISTORY:
c
c     5/06/92 (M. Xue)
c     Added full documentation.
C
c#######################################################################
c
c     INPUT :
c
c       a        A 3-D array whose max. and min. values is sought here.
c
c       m1,m2    The dimension bounds of the first  index of array a.
c       i1,i2    The bounds of 1st index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c       n1,n2    The dimension bounds of the second index of array a.
c       j1,j2    The bounds of 2nd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c       l1,l2    The dimension bounds of the third  index of array a.
c       k1,k2    The bounds of 3rd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c
c     OUTPUT:
c
c       amax     The maximum value of array a in a specified subdomain.
c       amin     The minimum value of array a in a specified subdomain.
c
c       imax,jmax,kmax  The index location of the maxmum value in i,j,k
c                       directions.
c       imin,jmin,kmin  The index location of the minmum value in i,j,k
c                       directions.
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none 

      integer m1,n1,l1,m2,n2,l2
      real    a(m1:m2,n1:n2,l1:l2)

      real amin, amax
      integer imax,jmax,kmax, imin,jmin,kmin
c
c#######################################################################
c
c     Misc. local variables: 
c
c#######################################################################
c
      integer i1,i2,j1,j2,k1,k2,i,j,k
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c

      imax = i1
      jmax = j1
      kmax = k1

      amax=a(i1,j1,k1)

      DO 10 k=k1,k2
      DO 10 j=j1,j2
      DO 10 i=i1,i2
        IF( a(i,j,k) .gt. amax ) THEN
          amax = a(i,j,k)
          imax = i
          jmax = j
          kmax = k
        ENDIF
 10   CONTINUE

      imin = i1
      jmin = j1
      kmin = k1

      amin=a(i1,j1,k1)

      DO 20 k=k1,k2
      DO 20 j=j1,j2
      DO 20 i=i1,i2
        IF( a(i,j,k) .lt. amin ) THEN
          amin = a(i,j,k)
          imin = i
          jmin = j
          kmin = k
        ENDIF
 20   CONTINUE

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE WRIGAR                     ######
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 WRIGAR(a,nx0,nx1,ny0,ny1,nz0,nz1,i0,i1,j0,j1,k0,k1,
     :           title,tkoff,mode)
c
c#######################################################################
c
c     PURPOSE:
c
c       Orchestrate the formatted printing of select 2-d slices of 3-d arrays. 
c       A subdomain (i0:i1,j0:j1,k0:k1) is selected for printing. A maxmimu 
c       width of 32 numbers can be printed in a horizontal direction. A 
c       portion of the array table may be truncated, and in case the arrays 
c       are large, the data are printed for every other data point. 
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     12/10/89.    
c
c     MODIFICATION HISTORY:
c
c     5/20/92 (M. Xue)
c     Added full documentation.
C
c#######################################################################
c
c     INPUT :
c
c       a        A 3-D array whose content will be printed.
c
c       nx0,nx1  The dimension bounds of the 1st index of array a.
c       ny0,ny1  The dimension bounds of the 2nd index of array a.
c       nz0,nz1  The dimension bounds of the 3rd index of array a.
c
c       i0,i1    The bounds of 1st index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c       j0,j1    The bounds of 2nd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c       k0,k1    The bounds of 3rd index defining a subdomain of array
c                a inside which the max. and min. of the array is sought
c
c       title    The name of the field, a character string.
c       tkoff    A value to be subtracted from array a for printing. 
c
c       Mode     A control parameter to select the slice to print.
c 
c                Mode =1, x-y slices will be printed.
c                Mode =2, x-z slices will be printed.
c                Mode =3, y-z slices will be printed.
c                Mode =0, all slices will be printed.
c
c     OUTPUT:
c
c       None. 
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none 

      integer nx0,nx1,ny0,ny1,nz0,nz1
      integer i0,i1,j0,j1,k0,k1

      real a(nx0:nx1,ny0:ny1,nz0:nz1)
      character title*(*)
      real tkoff
      integer mode
c
c#######################################################################
c
c     Misc. local variables: 
c
c#######################################################################
c
c
      integer i,j,k,modd,nap,nexp
      real armin,armax,scale,factor

      integer nplan, mstep
      parameter(nplan=9,mstep=10)
c
      integer iap(0:65)
c
      integer is,js,ks,ndigit,nunit,leng,nxmi,nymi,nzmi

      parameter(ndigit=2 ,nunit=6,leng=132)
      parameter(nxmi=33,nymi=5,nzmi=20)

      real eps
      parameter(eps=1.0e-30)
c
      integer ixp(nplan),iyp(nplan),izp(nplan)
      save ixp,iyp,izp
c
      data ixp/nxmi,-1,-1,-1,-1,-1,-1,-1,-1/
      data iyp/-1,-1,-1,-1,-1,-1,-1,-1,-1/
      data izp/-1,-1,-1,-1,-1,-1,-1,-1,-1/
c
      data iap/
     :   0,1,2,3,4,5,6,7,8,9
     :   ,10,11,12,13,14,15,16,17,18,19
     :   ,20,21,22,23,24,25,26,27,28,29
     :   ,30,31,32,33,34,35,36,37,38,39
     :   ,40,41,42,43,44,45,46,47,48,49
     :   ,50,51,52,53,54,55,56,57,58,59
     :   ,60,61,62,63,64,65/
c
c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
      external outarr
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
 
c
c#######################################################################
c
C     Calculates max and min for scaling:
c
c#######################################################################
c
C
      armin=a(i0,j0,k0)
      armax=armin

      DO 100 k=k0,k1
      DO 100 j=j0,j1
      DO 100 i=i0,i1
        armin=min(a(i,j,k),armin)
        armax=max(a(i,j,k),armax)
100   CONTINUE
C
c
c#######################################################################
c
c     Determine the scaling factor:
c
c#######################################################################
c
C
      write(nunit,1001) title,armin,armax
      IF(armax.eq.armin .or. mode.eq.4) RETURN
c
      armax=armax-tkoff
      armin=armin-tkoff
c
      scale=1.0e-30+max(abs(armax),abs(armin))
      nexp=int(alog10(scale))-ndigit

      IF(nint(scale*10.**(-nexp)) .eq. 10**(-nexp+1)) nexp=nexp+1

      IF(alog10(scale) .le. 0.)  nexp=nexp-1

      factor=10.**(-nexp)
c
      IF(k0.eq.k1) THEN

         modd=1

      ELSEIF(j0.eq.j1) THEN

         modd=2

      ELSEIF(i0.eq.i1) THEN

         modd=3

      ELSE

         modd=mode

      ENDIF

      is = max(1, nint( (i1-i0+1)/32.0 ))
      js = max(1, nint( (j1-j0+1)/32.0 ))
      ks = 1
c
      IF(modd.eq.0) THEN

         CALL outarr(a,nx0,nx1,i0,i1,is,ixp,ny0,ny1,j0,j1,js,iyp,
     :               nz0,nz1,k0,k1,ks,izp,nplan,leng,title,nunit,
     :               scale,nexp,factor,ndigit,tkoff,modd)

      ELSE

         IF(modd.eq.1) THEN

            nap=k1-k0+1

         ELSEIF(modd.eq.2) THEN

            nap=j1-j0+1

         ELSE

            nap=i1-i0+1

         ENDIF

         CALL outarr(a,nx0,nx1,i0,i1,is,iap(i0),ny0,ny1,j0,j1,js,iap(j0)
     :              ,nz0,nz1,k0,k1,ks,iap(k0),nap,leng,title,nunit,
     :               scale,nexp,factor,ndigit,tkoff,modd)
      ENDIF
c
1001  format(/t2,a8,t30,'Min=',E14.7,' Max=',E14.7)

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE OUTARR                     ######
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 OUTARR (a,l0,l1,i0,i1,is,ixp,m0,m1,j0,j1,js,iyp,
     :           n0,n1,k0,k1,ks,isp,nplan,leng,title,nchan,scale,nexp,
     :           factor,ndigit,tkoff,mode)
c
c#######################################################################
c
c     PURPOSE:
c 
c     Print a formatted table of a 2-d array. This subroutine is called by
c     WRIGRA.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     12/10/89.
c
c     MODIFICATION HISTORY:
c
c     5/06/92 (M. Xue)
c     Added full documentation.
C
c#######################################################################

      implicit none

      integer l0,l1,m0,m1,n0,n1
      real a(l0:l1,m0:m1,n0:n1)
      real tkoff, factor, scale
      integer mode, ndigit

      character title*(*)
      character*9 cmod(3)
      character*2 numero(39)
      character*20 forma1
      character*10 forma2
      character*13 forma3
      integer lc(-200:200)

      integer nplan
      integer ixp(nplan),iyp(nplan),isp(nplan)

      integer leng,lengl,i0,i1,j0,j1,k0,k1,is,js,ks
      integer nchan,nexp,lfield,line,ndec,ndig
      integer i11,i12,li,imax,kp,j11,j12,mi,jmax,jp,ip
      integer i,j,k 

      save cmod,forma1,numero,forma2,forma3
      data cmod/'plane is=','plane iy=','plane ix='/
      data numero/'01','02','03','04','05','06','07','08','09'
     :   ,'10','11','12','13','14','15','16','17','18','19'
     :   ,'20','21','22','23','24','25','26','27','28','29'
     :   ,'30','31','32','33','34','35','36','37','38','39'/
      data forma1/'(1x,i2,''*'',t6,31i04)'/
      data forma2/'(t6,31i04)'/
      data forma3/'(i4,04e30.23)'/

      lengl=leng-6
      lfield=ndigit+2
      line=lengl/lfield
      forma1(18:19)=numero(ndigit+2)
      forma1(15:16)=numero(line)
      forma2(8:9)=numero(ndigit+2)
      forma2(5:6)=numero(line)
      ndec=max(1,ndigit+2-7)
      ndig=ndec+7
      forma3(8:9)=numero(ndig)
      forma3(11:12)=numero(ndec)
      forma3(5:6)=numero(line)

      IF(mode.eq.0 .or. mode.eq.1) THEN

         i11=i0+min(i1-i0,(line-1)*is)
         imax=min(lengl,(lfield*((i1-i0)/is+1)))
         li=i0+(line-1)*is
         i12=min(i1,li)

         DO 210 kp=1,nplan

         IF(isp(kp).ge.n0) THEN
            k=isp(kp)
            write(nchan,10) title,tkoff,cmod(1),k,nexp
            write(nchan,forma2) (i,i=i0,i11,is)
            write(nchan,4) ('*',i=2,imax)

            DO 200 j=j1,j0,-js

            IF(ndigit.lt.15) THEN
               DO 220 i=i0,i1,is
               lc(i)=nint((a(i,j,k)-tkoff)*factor)
220            CONTINUE
               write(nchan,forma1) j,(lc(i),i=i0,i12,is)
            ELSE
               write(nchan,forma3) j,(a(i,j,k),i=i0,i12,is)
            ENDIF

200         CONTINUE

            write(nchan,4) ('*',i=2,imax)
         ENDIF

210      CONTINUE

      ENDIF

      IF(mode.eq.0 .or. mode.eq.2) THEN

         i11=i0+min(i1-i0,(line-1)*is)
         imax=min(lengl,(lfield*((i1-i0)/is+1)))
         li=i0+(line-1)*is
         i12=min(i1,li)

         DO 310 jp=1,nplan

         IF(iyp(jp).ge.m0) THEN
            j=iyp(jp)
            write(nchan,10) title,tkoff,cmod(2),j,nexp
            write(nchan,forma2) (i,i=i0,i11,is)
            write(nchan,4) ('*',i=2,imax)

c           DO 300 k=k0,k1,ks
            DO 300 k=k1,k0,-ks

            IF(ndigit.lt.15) THEN
               DO 320 i=i0,i1,is
               lc(i)=nint((a(i,j,k)-tkoff)*factor)
320            CONTINUE
               write(nchan,forma1) k,(lc(i),i=i0,i12,is)
            ELSE
               write(nchan,forma3) k,(a(i,j,k),i=i0,i12,is)
            ENDIF

300         CONTINUE
            write(nchan,4) ('*',i=2,imax)

         ENDIF

310      CONTINUE

      ENDIF

      IF(mode.eq.0 .or. mode.eq.3) THEN

         j11=j0+min(j1-j0,(line-1)*js)
         jmax=min(lengl,(lfield*((j1-j0)/js+1)))
         mi=j0+(line-1)*js
         j12=min(j1,mi)

         DO 410 ip=1,nplan

         IF(ixp(ip).ge.l0) THEN
            i=ixp(ip)
            write(nchan,10) title,tkoff,cmod(3),i,nexp
            write(nchan,forma2) (j,j=j11,j0,-js)
            write(nchan,4) ('*',j=2,jmax)

c           DO 400 k=k0,k1,ks
            DO 400 k=k1,k0,-ks

            IF(ndigit.lt.15) THEN
               DO 420 j=j1,j0,-js
               lc(j)=nint((a(i,j,k)-tkoff)*factor)
420            CONTINUE
               write(nchan,forma1) k,(lc(j),j=j12,j0,-js)
            ELSE
               write(nchan,forma3) k,(a(i,j,k),j=j12,j0,-js)
            ENDIF

400         CONTINUE

            write(nchan,4) ('*',j=2,jmax)
         ENDIF

410      CONTINUE

      ENDIF

      RETURN

2     format(T30,'Units of 10**',I3)
3     format(T6,31I4)
4     format(T7,125A1)
5     format(1X,I2,'*',T6,31I4)
10    format(//T7,A,'(add:',E10.3,')',3X,A,I4,5X,'Units of 10**'
     :   ,I3,/)

      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE PARRAY                     ######
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 PARRAY(a,m,n,char1)
c
c#######################################################################
c
c     PURPOSE:
c
c     Produces contour plots using NCARgraphic routine CONREC.
c     This subroutine calls the ncargraphic contouring routine CONREC.
c     This routine is not supported by ARPS.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     5/29/91.
c
c     MODIFICATION HISTORY:
c
c     5/06/92 (M. Xue)
c     Added full documentation.
C
c#######################################################################
c
c     INPUT :
c
c       a        A 2-D array whose max. and min. values is sought here.
c       m        The dimension bounds of the first  index of array a.
c       n        The dimension bounds of the second index of array a.
c       char1    A character string to be plotted along with the contour
c                map.
c
c     OUTPUT:
c
c       None
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none

      integer m,n
      real a(m,n)
      character char1*(*)
c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
c     external pwrit 
c     external conrec
c     external frame 
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      write(6,'(1x,a,a)')  'Plotting ',char1

c     CALL pwrit(.5,.975,char1,42,2,0,0)

      write(6,'(1x,a,2i5)')'Calling  conrec with ', m,n

c     CALL conrec(a,m,m,n,0,0,0,0,-638,-922)
c     CALL frame
 
      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE PLTARY                     ######
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 PLTARY(b, a, nx,nx1,ny,ny1,nz1, ch,takoff,time, mode)
c
C######################################################################
c
c     PURPOSE:
c
c     plot a central slice of a 3-d array. 
c         mode = 1: x-y slice
c              = 2: x-z slice
c              = 3: y-z slice
c     This subroutine calls the ncargraphic contouring routine CONREC,
c     NCAR-Graphic routines and not supported by ARPS.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     5/29/91.
c
c     MODIFICATION HISTORY:
c
c     5/06/92 (M. Xue)
c     Added full documentation.
C
C######################################################################
c
      implicit none

      integer nx,ny,nx1,ny1,nz1

      real b(nx,ny,nz1)    ! The input data array
      real a(1)            ! A work array

      character ch*(*)     ! A character string to be plotted.
      real time            ! The time of the data 
      real takoff          ! A value to be subtracted from the array
      integer mode         ! Parameter to control the selection of 
                           ! xy, xz or yz slice to be printed.
c
c#######################################################################
c
c     Misc. local variables: 
c
c#######################################################################
c
      integer i,j,k,ij,ik,jk
      character ch1*50

c
c#######################################################################
c
c     Routines called:
c
c#######################################################################
c
      external parray
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      IF(mode.eq.1) THEN

        k = (nz1-1)/2 + 1

        DO 10 j=1,ny1
        DO 10 i=1,nx1
          ij = i + (j-1)*nx1
          a(ij)=b(i,j,k)-takoff
10      CONTINUE

        write(ch1,'(''x-y slice of '',a,'' at t='',f8.1
     :    ,'' (s) for k='',i2)') ch,time,k
        write(6,'(1x,a,a)') 'Plotting', ch1(1:47)

        CALL parray(a,nx1,ny1,ch1(1:47))

      ELSEIF(mode.eq.2) THEN

        j = (ny1-1)/2 + 1

        DO 20 k=1,nz1
        DO 20 i=1,nx1
          ik = i + (k-1)*nx1
          a(ik)=b(i,j,k)-takoff
20      CONTINUE

        write(ch1,'(''x-z slice of '',a,'' at t='',f8.1
     :    ,'' (s) for j='',i2)') ch,time,j

        CALL parray(a,nx1,nz1,ch1(1:47))

      ELSE

        i = (nx1-1)/2 + 1

        DO 30 k=1,nz1
        DO 30 j=1,ny1
          jk = j + (k-1)*ny1
          a(jk)=b(i,j,k)-takoff
30      CONTINUE

        write(ch1,'(''y-z slice of '',a,'' at t='',f8.1
     :    ,'' (s) for i='',i2)') ch,time,i

        CALL parray(a,ny1,nz1,ch1(1:47))

      ENDIF

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE GTBASFN                    ######
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 GTBASFN(runname,dirname,ldirnam,hdmpfmt,
     :           basdmpfn,lbasdmpf )
c
C#######################################################################
c
c     PURPOSE:
c
c     Return a character string to be used as the name of the grid and 
c     base state array dump file. The name convention of the history 
c     dump data sets:
c         rrrrrr.bingrdbas.aa for unformatted binary data set.
c         rrrrrr.ascgrdbas.aa for formatted ASCII data set.
c         rrrrrr.hdfgrdbas.aa for HDF data set
c         rrrrrr.pakgrdbas.aa for packed binary data set
c     where rrrrrr denotes the name of this run, aa is a two digit number
c     appended to the data set name in case a data file called 
c     rrrrrr.hdfgrdbas.(aa-1) already exists on the disk.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     11/20/91
c
c     MODIFICATION HISTORY:
c
c     5/05/92 (M. Xue)
c     Added full documentation.
c
c     7/30/92 (M. Xue)
c     Added option for packed data set. 
c
c#######################################################################
c
c     INPUT:
c
c       runname  A character string for the name of this run.
c       dirname  A file directory name to be attached to the file name.
c       ldirnam  Length of the directory string name
c       hdmpfmt  Parameter specifying the format of output data set. 
c
c                hdmpfmt = 1 for unformatted binary output. 
c                hdmpfmt = 2 for formatted ascii output. 
c                hdmpfmt = 3 for NCSA HDF format output. 
c
c#######################################################################
c
c     OUTPUT:
c
c       basdmpfn The name of the data dump file.
c       lbasdmpf The length of character string basdmpfn. 
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none

      character runname*(*)     ! A string for the name of this run.
      character dirname*(*)     ! A string giving the file directory name
      integer   ldirnam         ! The length of the directory name
      integer   hdmpfmt         ! Parameter specifying the format of
                                ! output data set.
      character basdmpfn*80     ! The name of grid&base state data file.
      integer   lbasdmpf        ! The length of character string basdmpfn.
      integer   lenfil          ! Local work integer
c
c#######################################################################
c
c     Misc. local variables:
c
c#######################################################################
c
      integer nnn
      logical iexist
      character temchar*80
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      nnn = 0
      IF( hdmpfmt.eq.1 ) THEN       ! Unformatted binary dump

        basdmpfn = runname(1:6)//'.bingrdbas'

      ELSEIF( hdmpfmt.eq.2 ) THEN   ! Formatted ASCII dump

        basdmpfn = runname(1:6)//'.ascgrdbas'

      ELSEIF( hdmpfmt.eq.3 ) THEN   ! HDF data dump

        basdmpfn = runname(1:6)//'.hdfgrdbas'

      ELSEIF( hdmpfmt.eq.4 ) THEN   ! Packed binary dump

        basdmpfn = runname(1:6)//'.pakgrdbas'

      ELSEIF( hdmpfmt.eq.5 ) THEN   ! Savi3D data dump 
c
c     For Sevi3D data dump, the grid and base state information is
c     always written together the other fileds.

      ENDIF

      lbasdmpf = 16 

      IF( dirname.ne.' ' ) THEN

        temchar = basdmpfn
        basdmpfn = dirname(1:ldirnam)//'/'//temchar
        lbasdmpf  = lbasdmpf + ldirnam + 1

      ENDIF

      lenfil = lbasdmpf
200   inquire(file=basdmpfn(1:lbasdmpf), exist=iexist)

      IF(iexist)THEN

        nnn = nnn+1
        write(basdmpfn(lenfil+1:lenfil+3),'(a,i2.2)')  '.',nnn
        lbasdmpf = lenfil + 3
        GOTO 200

      ENDIF

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE GTDMPFN                    ######
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 GTDMPFN(runname,dirname,ldirnam,curtim,hdmpfmt, 
     :           hdmpfn, ldmpf )
c
C#######################################################################
c
c     PURPOSE:
c
c     Return a character string to be used as the name of the history dump 
c     data at time 'curtim'. The name convention of the history dump data 
c     sets:
c         rrrrrr.hdfnnnnnn.aa for hdf data set
c         rrrrrr.binnnnnnn.aa for unformatted binary data set.
c     where rrrrrr denotes the name of this run, nnnnnn indicates the time
c     in seconds at which this data set is valid, and aa is a two digit 
c     number appended to the data set name in case a data file called
c     rrrrrr.hdfnnnnnn.(aa-1) already exists on the disk.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     11/20/91
c
c     MODIFICATION HISTORY:
c
c     5/05/92 (M. Xue)
c     Added full documentation.
c
c     7/30/92 (M. Xue)
c     Added option for packed data set. 
c
c#######################################################################
c
c     INPUT:
c
c       runname  A character string for the name of this run.
c       dirname  A file directory name to be attached to the file name.
c       ldirnam  Length of the directory string name
c       curtim   The model time in seconds.
c       hdmpfmt  Parameter specifying the format of output data set. 
c
c                hdmpfmt = 1 for unformatted binary output. 
c                hdmpfmt = 2 for formatted ascii output. 
c                hdmpfmt = 3 for NCSA HDF format output. 
c
c#######################################################################
c
c     OUTPUT:
c
c       hdmpfn   The name of the history data dump file.
c       ldmpf    The length of character string hdmpfn. 
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none

      character runname*(*)     ! A string for the name of this run.
      character dirname*(*)     ! A string giving the file directory name
      integer   ldirnam         ! The length of the directory name
      real    curtim            ! Current model time.
      integer hdmpfmt           ! Parameter specifying the format of
                                ! output data set.
      character hdmpfn*80       ! The name of the history data dump file.
      integer ldmpf             ! The length of character string hdmpfn.
c
c#######################################################################
c
c     Misc. local variables:
c
c#######################################################################
c
      integer nnn, lenfil
      logical iexist
      character temchar*80
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      nnn = 0
      IF( hdmpfmt.eq.1 ) THEN       ! Unformatted binary dump

        write(hdmpfn,'(a,i6.6)') runname(1:6)//'.bin',nint(curtim)

      ELSEIF( hdmpfmt.eq.2 ) THEN   ! Formatted ASCII dump

        write(hdmpfn,'(a,i6.6)') runname(1:6)//'.asc',nint(curtim)

      ELSEIF( hdmpfmt.eq.3 ) THEN   ! HDF data dump

        write(hdmpfn,'(a,i6.6)') runname(1:6)//'.hdf',nint(curtim)

      ELSEIF( hdmpfmt.eq.4 ) THEN   ! Packed binary dump 

        write(hdmpfn,'(a,i6.6)') runname(1:6)//'.pak',nint(curtim)

      ELSEIF( hdmpfmt.eq.5 ) THEN   ! Data dump for Savi3D 

        write(hdmpfn,'(a)') runname(1:6)//'.svi'

      ENDIF

      ldmpf = 16 
      IF(  hdmpfmt.eq.5 ) ldmpf = 10

      IF( dirname.ne.' ' ) THEN

        temchar = hdmpfn
        hdmpfn = dirname(1:ldirnam)//'/'//temchar
        ldmpf  = ldmpf + ldirnam + 1

      ENDIF

      print*, hdmpfn(1:ldmpf),ldmpf

      lenfil = ldmpf
200   inquire(file=hdmpfn(1:ldmpf), exist=iexist)

      IF(iexist)THEN

        nnn = nnn+1
        write(hdmpfn(lenfil+1:lenfil+3),'(a,i2.2)')  '.',nnn
        ldmpf = lenfil + 3   

      print*, hdmpfn(1:ldmpf),ldmpf

        GOTO 200

      ENDIF

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE GTLOGFN                    ######
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 GTLOGFN( runname, logfn, llogfn ) 
c
C#######################################################################
c
c     PURPOSE:
c
c     Construct a character string to be used as the name of the input 
c     log file. The name convention of the log file: 
c         rrrrrr.log.aa
c     where rrrrrr denotes the name of this run and aa is a two digit 
c     number appended to the data set name in case the file
c     rrrrrr.log.(aa-1) already exists on the disk.
c
c#######################################################################
c
c     INPUT:
c
c       runname  A character string for the name of this run.
c
c     OUTPUT:
c
c       logfn    Log file filename. 
c       llogfn   The length of character string logfn. 
c
C#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none

      character runname*(*)     ! A character string for the name of
                                ! this run.
      character logfn*80        ! Log file filename.
      integer   llogfn          ! The length of character string logfn.
c
c#######################################################################
c
c     Misc. local variables:
c
c#######################################################################
c
      logical iexist
      integer nnn
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
      nnn = 0

      write(logfn,'(a)') runname(1:6)//'.log'

200   inquire(file=logfn, exist=iexist)

      llogfn = 10

      IF(iexist)THEN

        nnn = nnn+1
        write(logfn(11:13),'(a,i2.2)')  '.',nnn
        GOTO 200

      ENDIF

      llogfn = 13

      RETURN
      END

c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE STRLNTH                    ######
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 STRLNTH( string, length )
c
c#######################################################################
c      
c     PURPOSE:
c
c     Return the length of the non-blank part of a character string.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     11/20/91
c
c     MODIFICATION HISTORY:
c
c     5/05/92 (M. Xue)
c     Added full documentation.
c
c#######################################################################
c
c     INPUT:
c
c       string   A character string
c       length   The declared length of the character string 'string'.
c
c     OUTPUT:
c
c       length   The length of the non-blank part of the string.
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none

      character string*(*)      ! A character string for the name of
                                ! this run.
      integer length            ! The length of the non-blank part
                                ! of a string.

      integer i
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c

      DO 100 i = length,1,-1

        IF(string(i:i) .ne. ' ') GOTO 200

100   CONTINUE

200   CONTINUE

      length = max(1,i) 

      RETURN
      END
