      PROGRAM ARPSCVT
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                   PROGRAM ARPSCVT                    ######
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
c
c#######################################################################
c
c     PURPOSE:
c
c     Program to read history data dump from ARPS 3.0 and convert it into
c     another format. 
c
c     Parameters grdin,basin,mstin,icein,trbin are read in from the 
c     data file itself, therefore are determined internally.
c     Arrays that are not read in retains their initial zero values.
c     These parameters are passed among subroutines through
c     a common block defined in 'indtflg.inc'.
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c       8/10/1992
c
c     MODIFICATION HISTORY:
c
c#######################################################################
c
c     DATA ARRAYS READ IN:
c
c       x        x coordinate of grid points in physical/comp. space (m)
c       y        y coordinate of grid points in physical/comp. space (m)
c       z        z coordinate of grid points in computational space (m)
c       zp       z coordinate of grid points in physical space (m)
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
c       ptprt    perturbation 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       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     CALCULATED DATA ARRAYS:
c
c       u        x component of total velocity (m/s)
c       v        y component of total velocity (m/s)
c       w        z component of total velocity (m/s)
c       qv       total water vapor mixing ratio (kg/kg)
c
c     WORK ARRAYS:
c
c       tem1     Temporary work array.
c       tem2     Temporary work array.
c       svitem   Work array for Savi3D dump
c
c#######################################################################
c
c     Variable Declarations:
c
c#######################################################################
c
      implicit none
c
c#######################################################################
c
c     Include files:
c
c#######################################################################
c
      include 'dims.inc'
      include 'globcst.inc'
      include 'indtflg.inc'
c
c#######################################################################
c
c     Arrays to be read in:
c
c#######################################################################
c
      real x     (nx,ny,nz)
      real y     (nx,ny,nz)
      real z     (nx,ny,nz)
      real zp    (nx,ny,nz)     
      real x1d   (nx)
      real y1d   (ny)
      real z1d   (nz)
      real hterain(nx,ny)       
      real j1    (nx,ny,nz)
      real j2    (nx,ny,nz)
      real j3    (nx,ny,nz)

      real uprt  (nx,ny,nz) 
      real vprt  (nx,ny,nz)
      real wprt  (nx,ny,nz)
      real ptprt (nx,ny,nz)
      real pprt  (nx,ny,nz)

      real qvprt (nx,ny,nz)
      real qc    (nx,ny,nz)
      real qr    (nx,ny,nz)
      real qi    (nx,ny,nz)
      real qs    (nx,ny,nz)
      real qh    (nx,ny,nz)
      real km    (nx,ny,nz)

      real ubar  (nx,ny,nz)
      real vbar  (nx,ny,nz)
      real wbar  (nx,ny,nz)
      real ptbar (nx,ny,nz)
      real rhobar(nx,ny,nz)
      real pbar  (nx,ny,nz)
      real qvbar (nx,ny,nz)
C
      real u     (nx,ny,nz)
      real v     (nx,ny,nz)
      real w     (nx,ny,nz)
      real qv    (nx,ny,nz)
c
c#######################################################################
c
c     Temporary working arrays:
c
c#######################################################################
c
      real tem1(nx,ny,nz)
      real tem2(nx,ny,nz)
      real svitem(3*nx*ny*nz)   ! A work space required by Savi3D
                                ! library routines.
c
c#######################################################################
c
c     Misc. internal variables
c
c#######################################################################
c
      real time,psttim
      data psttim /0.0/

      integer hinfmt,houtfmt, nchout
      character grdbasfn*80,filename*80
      character basoutfn*80,houtfn*80
      integer   lbasoutf, loutf
      integer lenfil,lengbf

      integer gboutcnt, vroutcnt
      data    gboutcnt, vroutcnt /0,0/

      integer grdbas, stagrd
      integer ireply
      character*3 inflag, outflag
      integer i,j,k,ireturn,mode
      integer lentem,nnn
      logical iexist

      real amin, amax
c
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
C
C     Beginning of executable code...
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
c
c
      write(6,'(/9(/5x,a)/)')

     :'###############################################################',
     :'###############################################################',
     :'###                                                         ###',
     :'###                Welcome to ARPSCVT                       ###',
     :'###      This program converts the history dump data        ###',
     :'###      sets generated by ARPS, bewteen various formats.   ###',
     :'###                                                         ###',
     :'###############################################################',
     :'###############################################################'

      write(6,'(/a/)')' Please tell the program about the input data.'
      write(6,'(a)')
     :     ' Please give the input data format flag value (1/2/3/4):' 
      read(5,*) hinfmt 
c
c#######################################################################
c
c     Set the control parameters for output: 
c
c#######################################################################
c
      write(6,'(/a/)')' Now specify the output data format.'
      write(6,'(a)')  
     :     ' Specify the output data format flag value (1/2/3/4/5):'
      read(5,*) houtfmt

      IF( houtfmt.eq.hinfmt ) THEN
        write(6,'(/2(1x,a/))') 
     : 'Specified output data format was the same as the input,',
     : 'no conversion will be done. Job stopped.'
      ENDIF
c
c
      write(6,'(2(/5x,a)/)')
     :     'Do you want to dump out model grid arrays along with the',
     :     'time dependent fields? (select 0 or 1)'

      read(5,*) grdout

      write(6,'(2(/5x,a)/)')
     :     'Do you want to dump out the base state arrays',
     :     'along with the time dependent fields? (select 0 or 1)'

      read(5,*) basout

      write(6,'(2(/5x,a)/)')
     :     'Do you want to dump out u, v, w, ptprt and pprt arrays?',
     :     '(select 0 or 1)'

      read(5,*) varout

      write(6,'(2(/5x,a)/)')
     :     'Do you want to dump out any water and/or ice arrays? ',
     :     '(select 0 or 1)'

      read(5,*) mstout

      write(6,'(/5x,a/)')
     :     'Do you want to dump out any ice arrays? (select 0 or 1)'

      read(5,*) iceout


      write(6,'(2(/5x,a)/)')
     :     'Do you want to dump out turbulent mixing coefficient KM?',
     :     '(select 0 or 1)'

      read(5,*) trbout

c
c#######################################################################
c
c     Fill all arrays with zero, which is the default value of the 
c     data arrays.
c
c#######################################################################
c
      CALL flzero(x    ,nxyz)
      CALL flzero(y    ,nxyz)
      CALL flzero(z    ,nxyz)
      CALL flzero(zp   ,nxyz)
      CALL flzero(x1d  ,nx)
      CALL flzero(y1d  ,ny)
      CALL flzero(z1d  ,nz)
      CALL flzero(hterain,nxy)

      CALL flzero(uprt ,nxyz)
      CALL flzero(vprt ,nxyz)
      CALL flzero(wprt ,nxyz)
      CALL flzero(ptprt,nxyz)
      CALL flzero(pprt ,nxyz)
      CALL flzero(qvprt,nxyz)
      CALL flzero(qv   ,nxyz)
      CALL flzero(qc   ,nxyz)
      CALL flzero(qr   ,nxyz)
      CALL flzero(qi   ,nxyz)
      CALL flzero(qs   ,nxyz)
      CALL flzero(qh   ,nxyz)

      CALL flzero(u    ,nxyz)
      CALL flzero(v    ,nxyz)
      CALL flzero(w    ,nxyz)

      CALL flzero(ubar ,nxyz)
      CALL flzero(vbar ,nxyz)
      CALL flzero(wbar ,nxyz)
      CALL flzero(ptbar,nxyz)
      CALL flzero(pbar ,nxyz)
      CALL flzero(rhobar,nxyz)
      CALL flzero(qvbar,nxyz)

      CALL flzero(km   ,nxyz)

      CALL flzero(tem1 ,nxyz)
      CALL flzero(tem2 ,nxyz)

c
c#######################################################################
c
c     Get the name of the input data set.
c
c#######################################################################
c

      write(6,'(/a/a/a)')
     :' Please give the name of the file containing the grid and base',
     :' state array data. This file will not be read if the grid and ',
     :' base state arrays are present in each t-dependent data file.'
      read(5,*) grdbasfn

      lengbf=len(grdbasfn)
      CALL strlnth( grdbasfn, lengbf)
      write(6,'(/a,a)')' The grid/base name is ', grdbasfn(1:lengbf) 

101   CONTINUE

      write(6,'(/a)')
     :' Please give the name of the time-dependent data file.'
      read(5,*) filename

      lenfil=len(filename)
      CALL strlnth( filename, lenfil)
      write(6,'(/a,a)')' The data set name is ', filename(1:lenfil) 
c
c#######################################################################
c
c     Read all input data arrays
c
c#######################################################################
c
      psttim = curtim 

      CALL dtaread(nx,ny,nz, hinfmt,grdbasfn(1:lengbf),lengbf,
     :            filename(1:lenfil),lenfil,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, tem1)

      curtim = time
      thisdmp = curtim - psttim   ! These values will be used in svidump

      do i=1,nx-1
        x1d(i)=x(i,1,1)
      enddo 

      do j=1,ny-1
        y1d(j)=y(1,j,1)
      enddo 

      do k=1,nz-1
        z1d(k)=z(1,1,k)
      enddo 

c
      IF( ireturn.ne.0 ) GOTO 997 ! Read was unsuccessful 

      IF( houtfmt.eq.0 ) THEN
        write(6,'(/1x,a/)') 'Output format is 0, no data is dumped.'
        GOTO 140
      ENDIF
c
c#######################################################################
c
c     Calculate total fields from that for base state and perturbations
c
c#######################################################################
c
        DO 90 k=1,nz-1
        DO 90 j=1,ny-1
        DO 90 i=1,nx-1
          u(i,j,k)=uprt(i,j,k)+ubar(i,j,k)
          v(i,j,k)=vprt(i,j,k)+vbar(i,j,k)
          w(i,j,k)=wprt(i,j,k)+wbar(i,j,k)
          qv(i,j,k)=qvprt(i,j,k)+qvbar(i,j,k)
 90     CONTINUE
c
c#######################################################################
c 
c     Set the input and output data falgs to be used to construct
c     file names. 
c
c#######################################################################
c
      IF( hinfmt.eq.1 ) THEN   
        inflag = 'bin'
      ELSEIF( hinfmt.eq.2 ) THEN   
        inflag = 'asc'
      ELSEIF( hinfmt.eq.3 ) THEN   
        inflag = 'hdf'
      ELSEIF( hinfmt.eq.4 ) THEN   
        inflag = 'pak'
      ELSEIF( hinfmt.eq.5 ) THEN   
        inflag = 'svi'
      ENDIF

      IF( houtfmt.eq.1 ) THEN   
        outflag = 'bin'
      ELSEIF( houtfmt.eq.2 ) THEN   
        outflag = 'asc'
      ELSEIF( houtfmt.eq.3 ) THEN   
        outflag = 'hdf'
      ELSEIF( houtfmt.eq.4 ) THEN   
        outflag = 'pak'
      ELSEIF( houtfmt.eq.5 ) THEN   
        outflag = 'svi'
      ENDIF
c
c#######################################################################
c 
c     If grid/base state data has been written out once, skip
c     the following writing block. Also no need to write out
c     separate data for Savi3D dump. 
c
c#######################################################################
c
      If( houtfmt.eq.5 ) GOTO 300
  
      IF( gboutcnt.eq.1 ) GOTO 300 ! If done already, skip this part.

      lbasoutf = lengbf
      basoutfn = grdbasfn 

      DO 110 i=lbasoutf,3,-1
        IF( basoutfn(i-2:i).eq.inflag ) THEN 
          basoutfn(i-2:i)=outflag
        ENDIF
110   continue

      nnn = 0
      lentem = lbasoutf
200   inquire(file=basoutfn(1:lbasoutf), exist=iexist)

      IF(iexist)THEN

        nnn = nnn+1
        write(basoutfn(lentem+1:lentem+3),'(a,i2.2)')  '.',nnn
        lbasoutf = lentem + 3
        GOTO 200

      ENDIF

      Print*
      print*,'Output grid/base state file is ', basoutfn(1:lbasoutf)

      nchout = 80
      grdbas = 1      ! Dump out grd and base state arrays only
      stagrd = 0      ! Arrays are not staggered.

      CALL dtadump(nx,ny,nz, 
     :             houtfmt,nchout,basoutfn(1:lbasoutf),grdbas,stagrd,
     :             u,v,w,ptprt,pprt,qv,qc,qr,qi,qs,qh,km,
     :             ubar,vbar,wbar,ptbar,pbar,rhobar,qvbar,
     :             x1d,y1d,z1d,zp,hterain,j1,j2,j3, tem1,tem2,svitem)

      gboutcnt = 1       

300   CONTINUE
c
c#######################################################################
c 
c     Then the time dependent fields:
c
c#######################################################################
c
      IF( houtfmt.eq.5 .and. vroutcnt.eq.1 ) GOTO 130
                             ! use the same file name
      
      houtfn = filename 
      loutf = lenfil 

      DO 120 i=loutf,3,-1
        IF( houtfn(i-2:i).eq.inflag ) THEN 
          houtfn(i-2:i)=outflag
        ENDIF
120   continue

130   continue

      nnn = 0
      lentem = loutf
400   inquire(file=houtfn(1:loutf), exist=iexist)

      IF(iexist)THEN

        nnn = nnn+1
        write(houtfn(lentem+1:lentem+3),'(a,i2.2)')  '.',nnn
        loutf = lentem + 3
        GOTO 400

      ENDIF

      Print*
      print*,'Output file at time ',curtim,' (s) is ', houtfn(1:loutf)

      grdbas = 0      ! Not just dump out grd and base state arrays only
      stagrd = 0      ! Arrays are not staggered.

      CALL dtadump(nx,ny,nz,
     :             houtfmt,nchout,houtfn(1:loutf),grdbas,stagrd,
     :             u,v,w,ptprt,pprt,qv,qc,qr,qi,qs,qh,km,
     :             ubar,vbar,wbar,ptbar,pbar,rhobar,qvbar,
     :             x1d,y1d,z1d,zp,hterain, j1,j2,j3, tem1,tem2,svitem)


140   CONTINUE

      vroutcnt = 1

      write(6,801)
     :  ' Do you want to process another data set? (0 or 1)'
      read(5,*) ireply 

      IF( ireply .eq. 1) THEN
        write(6,'(/1x,a/)') 'Reply was 1, another data will be read.'
        GO TO 101
      ELSE
        write(6,'(/1x,a/)') 'Reply was 0, job is stopped here.'
      ENDIF

      IF (houtfmt .eq. 5) THEN

        CALL grafclose(grafh)

      ENDIF

      STOP

997   CONTINUE
      write(6,'(1x,a,i2,/1x,a)')
     :  'Data read was unsuccessful. ireturn =', ireturn,
     :  'Job stopped.'
      STOP

801   format(a)

      END
c
c
c     ##################################################################
c     ##################################################################
c     ######                                                      ######
c     ######                SUBROUTINE FLZERO                     ######
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 FLZERO(a,n)

c
c#######################################################################
c
c     PURPOSE:
c
c     Fill an entire array with zeros. 
c
c#######################################################################
c
c     AUTHOR: Ming Xue
c     10/10/1991.
c
c     MODIFICATION HISTORY:
c
c     5/02/92 (M. Xue)
c     Added full documentation.
C
c     5/03/92 (M. Xue)
c     Further documentation. 
C
c#######################################################################
c
c     INPUT :
c
c       n        The dimension of 1-D array a.
c
c     OUTPUT:
c
c       a        1-D array to be filled with zeros.
c
c#######################################################################
c

c
c#######################################################################
c
c     Variable Declarations.
c
c#######################################################################
c
      implicit none
c
c#######################################################################
c
c     Misc. local variables:
c
c#######################################################################
c
      integer i, n

      real a(n)

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

      DO 100 i=1,n
        a(i)=0.0
100   CONTINUE

      RETURN
      END
