!
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE SVIDUMP                    ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE svidump(nx,ny,nz,nstyps, nchout,graffn, grdbas,              & 1,4
           u,v,w,ptprt,pprt,qv,qc,qr,qi,qs,qh,tke,kmh,kmv,              &
           ubar,vbar,wbar,ptbar,pbar,rhobar,qvbar,                      &
           x,y,z,zp,hterain, j1,j2,j3,                                  &
           soiltyp,stypfrct,vegtyp,lai,roufns,veg,                      &
           tsfc,tsoil,wetsfc,wetdp,wetcanp,snowdpth,                    &
           raing,rainc,prcrate,                                         &
           radfrc,radsw,rnflx,                                          &
           usflx,vsflx,ptsflx,qvsflx,                                   &
           tem1, tem2)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Dump a data file for the visualization program Savi3D.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Jason J. Levit
!  07/20/92
!
!  MODIFICATION HISTORY:
!
!  08/02/92 (J. Levit)
!  Added full documentation and performed a clean-up.
!
!  08/04/92 (M. Xue)
!  Subroutine streamlined to conform to data dump format standards.
!
!  8/23/92 (M. Xue)
!  Modify to perform the dumping of both base and t-dependent arrays
!  and added control on grid staggering.
!
!  9/18/92 (J. Levit, M. Xue)
!  Added code to produce a configuration file for Savi3D.
!
!  11/2/92 (M. Xue)
!
!  Major overhaul. grafwritescalarpoint is called rather than
!  grafwritesclararray. This elliminates the need to define the
!  grid work array and make the data writing more flexible.
!
!  The capability to write out part of a data array implemented.
!
!  09/02/94 (J. Levit & Y. Lu)
!  Cleaned up documentation.
!
!  11/10/94 (Liping Sun & Min Zou)
!  Upgraded to version 1.2.2 of Savi3D. The file format was changed
!  from GRAF to MeRAF.
!
!  11/10/94 (Y. Liu)
!  Merged the upgraded version with the documentation cleaned up
!  version.
!
!  12/09/1998 (Donghai Wang)
!  Added the snow cover.
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    graffn   Name of the Savi3D MeRAF file.
!    grdbas   Flag indicating if this is a call for the data dump
!             of grid and base state arrays only. If so, grdbas=1
!             (not used in this routine).
!
!    u        x component of velocity at a given time level (m/s)
!    v        y component of velocity at a given time level (m/s)
!    w        Vertical component of Cartesian velocity at a given
!             time level (m/s)
!    ptprt    Perturbation potential temperature at a given time
!             level (K)
!    pprt     Perturbation pressure at  a given time level (Pascal)
!    qv       Water vapor specific humidity at a given time level
!             (kg/kg)
!    qc       Cloud water mixing ratio at a given time level (kg/kg)
!    qr       Rainwater mixing ratio at a given time level (kg/kg)
!    qi       Cloud ice mixing ratio at a given time level (kg/kg)
!    qs       Snow mixing ratio at a given time level (kg/kg)
!    qh       Hail mixing ratio at a given time level (kg/kg)
!
!    tke      Turbulent Kinetic Energy ((m/s)**2)
!    kmh      Horizontal turb. mixing coef. for momentum ( m**2/s )
!    kmv      Vertical turb. mixing coef. for momentum ( m**2/s )
!
!    ubar     Base state zonal velocity component (m/s)
!    vbar     Base state meridional velocity component (m/s)
!    wbar     Base state vertial velocity component (m/s)
!    ptbar    Base state potential temperature (K)
!    pbar     Base state pressure (Pascal)
!    rhobar   Base state density (kg/m**3)
!    qvbar    Base state water vapor specific humidity (kg/kg)
!
!    x        x coordinate of grid points in physical/comp. space (m)
!    y        y coordinate of grid points in physical/comp. space (m)
!    z        z coordinate of grid points in computational space (m)
!    zp       Vertical coordinate of grid points in physical space(m)
!    hterain  Terrain height (m)
!
!    j1       Coordinate transformation Jacobian -d(zp)/dx
!    j2       Coordinate transformation Jacobian -d(zp)/dy
!    j3       Coordinate transformation Jacobian  d(zp)/dz
!
!    soiltyp  Soil type
!    stypfrct  Soil type fraction
!    vegtyp   Vegetation type
!    lai      Leaf Area Index
!    roufns   Surface roughness
!    veg      Vegetation fraction
!
!    tsfc     Temperature at ground (K) (in top 1 cm layer)
!    tsoil    Deep soil temperature (K) (in deep 1 m layer)
!    wetsfc   Surface soil moisture in the top 1 cm layer
!    wetdp    Deep soil moisture in the deep 1 m layer
!    wetcanp  Canopy water amount
!
!    raing    Grid supersaturation rain
!    rainc    Cumulus convective rain
!    prcrate  Precipitation rates
!
!    radfrc   Radiation forcing (K/s)
!    radsw    Solar radiation reaching the surface
!    rnflx    Net radiation flux absorbed by surface
!
!    usflx    Surface flux of u-momentum (kg/(m*s**2))
!    vsflx    Surface flux of v-momentum (kg/(m*s**2))
!    ptsflx   Surface heat flux (K*kg/(m**2 * s ))
!    qvsflx   Surface moisture flux of (kg/(m**2 * s))
!
!    grafgrid Passed from a dummy variable, used to define the grid
!             in Savi3D
!
!  OUTPUT:
!
!    None.
!
!  WORK ARRAY:
!
!    tem1     Temporary work array.
!    tem2     Temporary work array.
!
!-----------------------------------------------------------------------
!

!
!-----------------------------------------------------------------------
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
  INTEGER :: nx,ny,nz          ! Number of grid points in 3 directions
!
  CHARACTER (LEN=*     ) :: graffn ! Name of the Savi3D MeRAF file
  INTEGER :: grdbas            ! If this is a grid/base state dump
!
  REAL :: u     (nx,ny,nz)     ! Total u-velocity (m/s)
  REAL :: v     (nx,ny,nz)     ! Total v-velocity (m/s)
  REAL :: w     (nx,ny,nz)     ! Total w-velocity (m/s)
  REAL :: ptprt (nx,ny,nz)     ! Perturbation potential temperature (K)
  REAL :: pprt  (nx,ny,nz)     ! Perturbation pressure (Pascal)
!
  REAL :: qv    (nx,ny,nz)     ! Water vapor specific humidity (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 :: tke   (nx,ny,nz)     ! Turbulent Kinetic Energy ((m/s)**2)
!
  REAL :: kmh   (nx,ny,nz)     ! Horizontal turb. mixing coef. for
                               ! momentum. ( m**2/s )
  REAL :: kmv   (nx,ny,nz)     ! Vertical turb. mixing coef. for
                               ! momentum. ( m**2/s )
!
  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 specific
                               ! humidity (kg/kg)

  REAL :: x     (nx)           ! The x-coord. of the physical and
                               ! computational grid. Defined at u-point.
  REAL :: y     (ny)           ! The y-coord. of the physical and
                               ! computational grid. Defined at v-point.
  REAL :: z     (nz)           ! The z-coord. of the computational grid.
                               ! Defined at w-point on the staggered grid.
  REAL :: zp    (nx,ny,nz)     ! The physical height coordinate defined
                               ! at w-point of the staggered grid.

  REAL :: hterain(nx,ny)       ! Terrain height.
  REAL :: j1    (nx,ny,nz)     ! Coordinate transformation Jacobian
                               ! defined as - d( zp )/d( x )
  REAL :: j2    (nx,ny,nz)     ! Coordinate transformation Jacobian
                               ! defined as - d( zp )/d( y )
  REAL :: j3    (nx,ny,nz)     ! Coordinate transformation Jacobian
                               ! defined as d( zp )/d( z )

  INTEGER :: nstyps
  INTEGER :: soiltyp (nx,ny,nstyps)    ! Soil type
  REAL :: stypfrct(nx,ny,nstyps)    ! Soil type
  INTEGER :: vegtyp(nx,ny)             ! Vegetation type
  REAL :: lai    (nx,ny)            ! Leaf Area Index
  REAL :: roufns (nx,ny)            ! Surface roughness
  REAL :: veg    (nx,ny)            ! Vegetation fraction

  REAL :: tsfc   (nx,ny,0:nstyps)      ! Temperature at surface (K)
  REAL :: tsoil  (nx,ny,0:nstyps)      ! Deep soil temperature (K)
  REAL :: wetsfc (nx,ny,0:nstyps)      ! Surface soil moisture
  REAL :: wetdp  (nx,ny,0:nstyps)      ! Deep soil moisture
  REAL :: wetcanp(nx,ny,0:nstyps)      ! Canopy water amount
  REAL :: snowdpth(nx,ny)              ! Snow depth (m)

  REAL :: raing(nx,ny)         ! Grid supersaturation rain
  REAL :: rainc(nx,ny)         ! Cumulus convective rain
  REAL :: prcrate(nx,ny,4)     ! precipitation rates (kg/(m**2*s))
                               ! prcrate(1,1,1) = total precip. rate
                               ! prcrate(1,1,2) = grid scale precip. rate
                               ! prcrate(1,1,3) = cumulus precip. rate
                               ! prcrate(1,1,4) = microphysics precip. rate

  REAL :: radfrc(nx,ny,nz)     ! Radiation forcing (K/s)
  REAL :: radsw (nx,ny)        ! Solar radiation reaching the surface
  REAL :: rnflx (nx,ny)        ! Net radiation flux absorbed by surface

  REAL :: usflx (nx,ny)        ! Surface flux of u-momentum (kg/(m*s**2))
  REAL :: vsflx (nx,ny)        ! Surface flux of v-momentum (kg/(m*s**2))
  REAL :: ptsflx(nx,ny)        ! Surface heat flux (K*kg/(m*s**2))
  REAL :: qvsflx(nx,ny)        ! Surface moisture flux (kg/(m**2*s))

  REAL :: tem1  (nx*ny*nz)     ! Temporary work array
  REAL :: tem2  (nx,ny,nz)     ! Temporary work array
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!

  INCLUDE 'meraf.inc'
  INCLUDE 'globcst.inc'
!  include 'grafibm.inc'
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: nxout,nyout,nzout ! The size of array to be written out.

  INTEGER :: ist ,ind ,isk ,jst ,jnd ,jsk ,kst ,knd ,ksk
  INTEGER :: ist1,ind1,isk1,jst1,jnd1,jsk1,kst1,knd1,ksk1

  INTEGER :: uid, vid, wid, uprtid, vprtid, wprtid        !*****
  INTEGER :: qvprtid, qcid, qrid, qwid, qiid, qsid, qhid  !*****
  INTEGER :: vortid, divid, ubarid, vbarid, wbarid        !*****
  INTEGER :: pbarid, rhobarid, qvbarid   !*****
  INTEGER :: windid, totalwindid         !*****
  INTEGER :: ptprtid, ptbarid, pprtid    !*****
  INTEGER :: value             ! *****
  INTEGER :: frame             ! *****

  INTEGER :: ierr              ! Used as an int'l error code by Savi3D.
  INTEGER :: i,j,k             ! Used by do loops.
  INTEGER :: ii,jj,kk
  INTEGER :: nchout            ! Unused.
  INTEGER :: ishf, jshf, kshf
  CHARACTER (LEN=50) :: configname   ! Used to create Savi3D config file.

  CHARACTER (LEN=20) :: schemename   !
  CHARACTER (LEN=40) :: errorstring  !
  REAL*8 xbase,ybase,zbase  ! ****

  REAL :: conx, cony       ! Used to create Savi3D config file.
  INTEGER :: gbwrtn            ! See if grid and base state
                               ! parameter/arrays have been written
                               ! into the data file
  INTEGER :: ncalls
  DATA gbwrtn,ncalls /0,0/
  SAVE gbwrtn,ncalls
  CHARACTER (LEN=7) :: chtem2
  CHARACTER (LEN=7) :: chtem1
                                ! Used to create Savi3D config file.
  CHARACTER (LEN=6) :: timhms

!  integer year,month,day,hour,minute,second,node ! def. in globcst.inc
  INTEGER :: node
  REAL :: tem
  REAL :: xcord,ycord,zcord
  REAL*8 second1            ! Used for Savi3D
  INTEGER :: nchout0         ! Used to open Savi3D config file.

  INTEGER :: setdomn,setskip
  SAVE setdomn, setskip
  SAVE ist,ind,isk,jst,jnd,jsk,kst,knd,ksk
  DATA setdomn/0/, setskip /0/
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
  IF( setdomn == 0 ) THEN
    ist = 1
    ind = nx-1
    jst = 1
    jnd = ny-1
    kst = 1
    knd = nz-1
  END IF

  IF( setskip == 0 ) THEN
    isk = 1
    jsk = 1
    ksk = 1
  END IF

  WRITE(6,'(/1x,a,f8.1,a/)')                                            &
       'Writing Savi3D data set at time=',curtim,' s.'
!
!-----------------------------------------------------------------------
!
!  The dimension of the array to be written out:
!
!-----------------------------------------------------------------------
!
  nxout = (ind-ist)/isk +1
  nyout = (jnd-jst)/jsk +1
  nzout = (knd-kst)/ksk +1

  IF( ncalls == 0) THEN
!
!-----------------------------------------------------------------------
!
!  Create the Savi3D configuration file.
!
!-----------------------------------------------------------------------
!
    CALL getunit( nchout0 )
    CALL gtlfnkey(runname, lfnkey)

    configname=runname(1:lfnkey)//'.sviconfig'
    OPEN (UNIT=nchout0,                                                 &
          FILE=configname(1:10+lfnkey),STATUS='unknown',                &
          FORM='formatted')

    cony=(y(ind)-y(ist))/111111.0
    conx=(x(jnd)-x(jst))/111111.0

    WRITE(chtem1,'(f7.3)') cony
    WRITE(chtem2,'(f7.3)') conx

    DO i=1,7
      IF ( chtem1(i:i) == ' ') chtem1(i:i) = '0'
      IF ( chtem2(i:i) == ' ') chtem2(i:i) = '0'
    END DO

    WRITE (nchout0,'(4a)')                                              &
        'toplat=',chtem1,',btmlat=000.000,lftlon=000.000,rhtlon=',chtem2
    WRITE (nchout0,'(a,a)') 'MeRAF_gridded=',graffn
    WRITE (nchout0,'(a)') 'initzstretch=1'

    WRITE (6,'(a,a)') 'MeRAF_gridded=',graffn
    WRITE (6,'(a)') 'initzstretch=1'

    CLOSE (nchout0)
    CALL retunit( nchout0 )

    ncalls = 1
  END IF

  ishf = 1
  jshf = 1
  kshf = 1
!
!-----------------------------------------------------------------------
!
!  Setup for the MeRAF interface.  This is only done at time=0,
!  and calls are made to Savi3D subroutines to define the type of
!  grid which the data are being written to.
!
!  Also, the scalar variables are defined for Savi3D here.
!
!-----------------------------------------------------------------------
!
  IF ( gbwrtn == 0 ) THEN

    PRINT*,' Opening Savi3D file ',graffn

!
!-----------------------------------------------------------------------
!
!  Create the data set
!
!-----------------------------------------------------------------------
!

    CALL mcreatedataset (graffn,'ARPS 4.0',true,dsindex,ierr)
    IF ( ierr == meerr ) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to create data set'
      PRINT*, 'Error Message: ',errorstring
    END IF

!
!-----------------------------------------------------------------------
!
!  Create a Grid
!
!-----------------------------------------------------------------------
!

    CALL mcreategrid(dsindex,'ARPS 4.0',' ','3-D Model',                &
                     3, nxout, nyout, nzout, ' ',' ', gridid, ierr)
    IF ( ierr == meerr ) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to create grid scheme'
      PRINT*, 'Error Message: ',errorstring
    END IF

!
!-----------------------------------------------------------------------
!
!  Set up Grid
!
!-----------------------------------------------------------------------
!

    CALL mconfigurelocations(gridid, me_non_time_var,                   &
                             mecartesian, ' ', ierr)
    IF ( ierr == meerr ) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to configue locations'
      PRINT*, 'Error Message: ',errorstring
    END IF

    frame=0
    xbase=0.0D0
    ybase=0.0D0
    zbase=0.0D0

    CALL msetxyzbase (gridid, xbase, ybase, zbase, ierr)
    IF ( ierr == meerr ) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to set base point'
      PRINT*, 'Error Message: ',errorstring
    END IF

!
!-----------------------------------------------------------------------
!
!   Define Scalars
!
!-----------------------------------------------------------------------
!

    IF (varout == 1) THEN

      CALL mdefinescalar (gridid,'u','X-velocity total wind',           &
           'm/s', 'X-velocity total wind',                              &
           me_time_var, uid)
      IF ( uid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'u'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar(gridid,'v','Y-velocity total wind',            &
            'm/s', 'Y-velocity total wind',                             &
            me_time_var, vid)
      IF ( vid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'v'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar(gridid,'w','Z-velocity total wind',            &
            'm/s', 'Z-velocity total wind',                             &
            me_time_var, wid)
      IF ( wid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'w'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar(gridid,'uprt','X-velocity perturbation',       &
            'm/s', 'X-velocity perturbation',                           &
            me_time_var, uprtid)
      IF ( uprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'uprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar(gridid,'vprt','Y-velocity perturbation',       &
            'm/s', 'Y-velocity perturbation',                           &
            me_time_var, vprtid)
      IF ( vprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'vprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar(gridid,'wprt','Z-velocity perturbation',       &
            'm/s', 'Z-velocity perturbation',                           &
            me_time_var, wprtid)
      IF ( wprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'wprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'ptprt',                               &
           'Perturbation Potential Temperature','deg K',                &
           'Perturbation Potential Temperature',                        &
           me_time_var, ptprtid)
      IF ( ptprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'ptprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'pprt',                                &
            'Perturbation Pressure','mb',                               &
            'Perturbation Pressure',                                    &
            me_time_var, pprtid)
      IF ( pprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'pprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

    END IF

    IF (mstout == 1) THEN

      CALL mdefinescalar (gridid,'qvprt',                               &
           'Water Vapor Mixing Ratio Perturbation','g/kg',              &
           'Water Vapor Mixing Ratio Perturbation',                     &
           me_time_var, qvprtid)
      IF ( qvprtid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'qvprt'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'qc',                                  &
           'Cloud Water Mixing Ratio','g/kg',                           &
           'Cloud Water Mixing Ratio',                                  &
           me_time_var, qcid)
      IF ( qcid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'qc'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'qr',                                  &
           'Rain Water Mixing Ratio','g/kg',                            &
           'Rain Water Mixing Ratio',                                   &
           me_time_var, qrid)
      IF ( qrid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'qr'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'qw',                                  &
           'Total Water Mixing Ratio','g/kg',                           &
           'Total Water Mixing Ratio',                                  &
           me_time_var, qwid)
      IF ( qwid == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar', 'qw'
        PRINT*, 'Error Message: ',errorstring
      END IF

      IF (iceout == 1) THEN

        CALL mdefinescalar (gridid,'qi',                                &
             'Cloud Ice Mixing Ratio','g/kg',                           &
             'Cloud Ice Mixing Ratio',                                  &
             me_time_var, qiid)
        IF ( qiid == meerr ) THEN
          CALL mgeterror (errorstring)
          PRINT*, 'Error: Unable to define scalar', 'qi'
          PRINT*, 'Error Message: ',errorstring
        END IF

        CALL mdefinescalar (gridid,'qs',                                &
             'Snow Mixing Ratio','g/kg',                                &
             'Snow Mixing Ratio',                                       &
             me_time_var, qsid)
        IF (qsid == meerr) THEN
          CALL mgeterror (errorstring)
          PRINT*, 'Error: Unable to define scalar','qs'
          PRINT*, 'Error Message: ',errorstring
        END IF

        CALL mdefinescalar (gridid,'qh',                                &
             'Hail Mixing Ratio','g/kg',                                &
             'Hail Mixing Ratio',                                       &
             me_time_var, qhid)
        IF (qhid == meerr) THEN
          CALL mgeterror (errorstring)
          PRINT*, 'Error: Unable to define scalar','qh'
          PRINT*, 'Error Message: ',errorstring
        END IF

      END IF

    END IF

    CALL mdefinescalar (gridid,'Vort','Vertical vorticity',             &
          '1/s', 'Vertical vorticity',                                  &
         me_time_var, vortid)
    IF (vortid == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to define scalar','Vort'
      PRINT*, 'Error Message: ',errorstring
    END IF

    CALL mdefinescalar (gridid,'Div','Horizontal divergence',           &
          '1/s', 'Horizontal divergence',                               &
         me_time_var, divid)
    IF (divid == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to define scalar','Div'
      PRINT*, 'Error Message: ',errorstring
    END IF

!
!-----------------------------------------------------------------------
!
!  The definitions for the time invariant scalars for Savi3D.
!  They are only written once to the Savi3D MeRAF file (at time=0).
!
!-----------------------------------------------------------------------
!

    IF (basout == 1) THEN

      CALL mdefinescalar (gridid,'ubar',                                &
           'Base State X Wind Velocity ','m/s',                         &
           'Base State X Wind Velocity',                                &
           me_time_var, ubarid)
      IF (ubarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','ubar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'vbar',                                &
           'Base State Y Wind Velocity ','m/s',                         &
           'Base State Y Wind Velocity',                                &
           me_time_var, vbarid)
      IF (vbarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','vbar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'wbar',                                &
           'Base State Z Wind Velocity ','m/s',                         &
           'Base State Z Wind Velocity',                                &
           me_time_var, wbarid)
      IF (wbarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','wbar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'ptbar',                               &
           'Base State Potential Temperature ','deg K',                 &
           'Base State Potential Temperature',                          &
            me_time_var, ptbarid)
      IF (ptbarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','ptbar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'pbar',                                &
           'Base State Pressure ','mb',                                 &
           'Base State Pressure',                                       &
           me_time_var, pbarid)
      IF (pbarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','pbar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinescalar (gridid,'rhobar',                              &
           'Base State Air Density ','kg/m**3',                         &
           'Base State Air Density',                                    &
           me_time_var, rhobarid)
      IF (rhobarid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define scalar','rhobar'
        PRINT*, 'Error Message: ',errorstring
      END IF

      IF (mstout == 1) THEN

        CALL mdefinescalar (gridid,'qvbar',                             &
               'Base State Water Vapor Mixing Ratio ','g/kg',           &
               'Base State Water Vapor Mixing Ratio',                   &
               me_time_var, qvbarid)
        IF (qvbarid == meerr) THEN
          CALL mgeterror (errorstring)
          PRINT*, 'Error: Unable to define scalar','qvbar'
          PRINT*, 'Error Message: ',errorstring
        END IF

      END IF

    END IF

!
!-----------------------------------------------------------------------
!
!  Vector definitions for Savi3D.  Also, define the starting date,
!  time, and time step for Savi3D.
!
!-----------------------------------------------------------------------
!

!
!-----------------------------------------------------------------------
!
!  Define Vectors
!
!-----------------------------------------------------------------------
!

    IF (varout == 1) THEN

      CALL mdefinevectori(gridid,'Pertubation_Wind',                    &
          'Pertubation_Wind',                                           &
          uprtid, vprtid, wprtid, windid)
      IF (windid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define vector','Wind'
        PRINT*, 'Error Message: ',errorstring
      END IF

      CALL mdefinevectori(gridid,'Total_Wind','Total_Wind',             &
                          uid, vid, wid, totalwindid)
      IF (totalwindid == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to define vector','Total_Wind'
        PRINT*, 'Error Message: ',errorstring
      END IF

    END IF

  END IF

!
!-----------------------------------------------------------------------
!
!  Write buffers
!
!-----------------------------------------------------------------------
!

  CALL msetbufferwrite (gridid, ierr)
  IF (ierr == meerr) THEN
    CALL mgeterror (errorstring)
    PRINT*, 'Error: Unable to set buffer write mode'
    PRINT*, 'Error Message: ',errorstring
  END IF

!
!-----------------------------------------------------------------------
!
!   Set Grid Point Locations
!
!-----------------------------------------------------------------------
!

  node = 0
  DO k=kst,knd,ksk
    DO j=jst,jnd,jsk
      DO i=ist,ind,isk
        ii=(i-ist)/isk+1
        jj=(j-jst)/jsk+1
        kk=(k-kst)/ksk+1
        xcord =(x(i)+x(i+ishf)-x(ist)-x(ist+ishf) )
        ycord =(y(j)+y(j+jshf)-y(jst)-y(jst+jshf) )
        zcord =(zp(i,j,k)+zp (i,j,k+kshf))
        CALL msetxyzlocation( gridid, ii, jj, kk, xcord,ycord,          &
                              zcord, ierr)
        IF( ierr == meerr) THEN
          CALL mgeterror(errorstring)
          PRINT*,'Error: Unable to set Locations'
          PRINT*,'Error Message: ',errorstring
        END IF
        node=node+1
      END DO
    END DO
  END DO

  IF ( node /= nxout*nyout*nzout ) THEN
    WRITE(6,'(1x,a,a)') 'nxout*nyout*nzout value incorrect.',           &
                        ' Job stopped in SVIDUMP.'
    CALL arpsstop(' ',1)
  END IF

!-----------------------------------------------------------------------
!
!  Write the base state time invariant scalars to the Savi3D file.
!  Data is written the first time this routine is called.
!
!-----------------------------------------------------------------------
!

  CALL mstartframew (gridid, ierr)
  IF ( ierr == meerr ) THEN
    CALL mgeterror (errorstring)
    PRINT*, 'Error: Unable to start frame write'
    PRINT*, 'Error Message: ',errorstring
  END IF

  frame=frame+1
  PRINT*, 'frame=', frame

  year  = 1994
  month = 7
  day   = 1

  CALL cvttim(curtim, timhms)
  READ(timhms,'(3i2)') hour, minute,second
  second1=second
  PRINT*,'year=',year,',month=',month,',day=',day
  PRINT*,'hour=',hour,',minute=',minute,',second=',second1

!  CALL GrafTimeStart(grafh,year,month,day,hour,minute,second)

  CALL msettimestampu( gridid, year, month, day, hour, minute,          &
                       second1, 0, 0, ierr)
  IF ( ierr == meerr ) THEN
    CALL mgeterror (errorstring)
    PRINT*, 'Error: Unable to set time stamp'
    PRINT*, 'Error Message: ',errorstring
  END IF

  IF ( gbwrtn == 0 ) THEN

    IF (basout == 1 ) THEN

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = ((ubar(i,j,k)+ubar(i+ishf,j,k))*0.5)
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,ubarid,1,nxout,                    &
             1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. ubarID=', ubarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = ((vbar(i,j,k)+vbar(i+ishf,j,k))*0.5)
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,vbarid,1,nxout,                    &
              1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. vbarID=', vbarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = ((wbar(i,j,k)+wbar(i+ishf,j,k))*0.5)
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,wbarid,1,nxout,                    &
                              1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. wbarID=', wbarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = ptbar(i,j,k)
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,ptbarid,1,nxout,                   &
                              1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. ptbar=', ptbarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = pbar(i,j,k)/100.0
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,pbarid,1,nxout,                    &
                              1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. pbarID=', pbarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = rhobar(i,j,k)
          END DO
        END DO
      END DO

      CALL mwritescalararrayi(gridid,rhobarid,1,nxout,                  &
                            1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. rhobarID=',rhobarid
        PRINT*, 'Error Message: ',errorstring
      END IF

      IF (mstout == 1) THEN

        node = 0
        DO k=kst,knd,ksk
          DO j=jst,jnd,jsk
            DO i=ist,ind,isk
              node = node + 1
              tem1(node) = qvbar(i,j,k)*1000.0
            END DO
          END DO
        END DO

        CALL mwritescalararrayi(gridid,qvbarid,1,nxout,                 &
                                1,nyout,1,nzout,tem1,ierr)
        IF (ierr == meerr) THEN
          CALL mgeterror (errorstring)
          PRINT*, 'Error: Unable to write scalar. qvbarID=', qvbarid
          PRINT*, 'Error Message: ',errorstring
        END IF

      END IF

    END IF

  END IF

!
!-----------------------------------------------------------------------
!
!  Write the scalar arrays to the Savi3D file, and mark the end
!  of the frame to the file.
!
!-----------------------------------------------------------------------
!

  IF (varout == 1) THEN

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = (u(i,j,k)+u(i+ishf,j,k))*0.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, uid,1,nxout,                       &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. uID=', uid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(v(i,j,k)+v(i,j+jshf,k))*0.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, vid,1,nxout,                       &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. vID=', vid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(w(i,j,k)+w(i,j,k+kshf))*0.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, wid,1,nxout,                       &
          1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. wID=', wid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(u(i,j,k)+u(i+ishf,j,k)                           &
              -ubar(i,j,k)-ubar(i+ishf,j,k))*.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, uprtid,1,nxout,                    &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. uprtID=', uprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(v(i,j,k)+v(i,j+jshf,k)                           &
              -vbar(i,j,k)-vbar(i,j+jshf,k))*.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, vprtid,1,nxout,                    &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. vprtID=', vprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(w(i,j,k)+w(i,j,k+kshf))*0.5
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, wprtid,1,nxout,                    &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. wprID=', wprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = ptprt(i,j,k)
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid,ptprtid,1,nxout,                    &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. ptprtID=', ptprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = pprt(i,j,k)*0.01
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, pprtid,1,nxout,                    &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. pprtID=', pprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

  END IF

  IF (mstout == 1) THEN

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) =(qv(i,j,k)-qvbar(i,j,k))*1000.0
        END DO
      END DO
    END DO

    CALL mwritescalararrayi(gridid,qvprtid,1,nxout,                     &
                            1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. qvprtID=', qvprtid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = qc(i,j,k)*1000.0
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, qcid,1,nxout,                      &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. qcID=', qcid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = qr(i,j,k)*1000.0
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, qrid,1,nxout,                      &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. qrID=', qrid
      PRINT*, 'Error Message: ',errorstring
    END IF

    node = 0
    DO k=kst,knd,ksk
      DO j=jst,jnd,jsk
        DO i=ist,ind,isk
          node = node + 1
          tem1(node) = (qc(i,j,k)+qr(i,j,k))*1000.0
        END DO
      END DO
    END DO

    CALL mwritescalararrayi (gridid, qwid,1,nxout,                      &
                             1,nyout,1,nzout,tem1,ierr)
    IF (ierr == meerr) THEN
      CALL mgeterror (errorstring)
      PRINT*, 'Error: Unable to write scalar. qwID=', qwid
      PRINT*, 'Error Message: ',errorstring
    END IF

    IF (iceout == 1) THEN

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = qi(i,j,k)*1000.0
          END DO
        END DO
      END DO

      CALL mwritescalararrayi (gridid, qiid,1,nxout,                    &
                               1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. qiID=', qiid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = qs(i,j,k)*1000.0
          END DO
        END DO
      END DO

      CALL mwritescalararrayi (gridid, qsid,1,nxout,                    &
                               1,nyout,1,nzout,tem1,ierr)
      IF (ierr == meerr) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. qsID=', qsid
        PRINT*, 'Error Message: ',errorstring
      END IF

      node = 0
      DO k=kst,knd,ksk
        DO j=jst,jnd,jsk
          DO i=ist,ind,isk
            node = node + 1
            tem1(node) = qh(i,j,k)*1000.0
          END DO
        END DO
      END DO

      CALL mwritescalararrayi (gridid, qhid,1,nxout,                    &
                               1,nyout,1,nzout,tem1,ierr)
      IF ( ierr == meerr ) THEN
        CALL mgeterror (errorstring)
        PRINT*, 'Error: Unable to write scalar. qhID=', qhid
        PRINT*, 'Error Message: ',errorstring
      END IF

    END IF

  END IF

!
!  Vorticity:
!
  DO k=2,nz-2
    DO j=2,ny-2
      DO i=2,nx-2
        tem2(i,j,k)=                                                    &
            (v(i+1,j,k)-v(i-1,j,k)+v(i+1,j+1,k)-v(i-1,j+1,k))/          &
            (4*(x(i+1)-x(i)))-                                          &
            (u(i,j+1,k)-u(i,j-1,k)+u(i+1,j+1,k)-u(i+1,j-1,k))/          &
            (4*(y(j+1)-y(j)))
      END DO
    END DO
  END DO

  DO j=2,ny-2
    DO i=2,nx-2
      tem2(i,j,   1)=tem2(i,j,   2)
      tem2(i,j,nz-1)=tem2(i,j,nz-2)
    END DO
  END DO

  DO k=1,nz-1
    DO j=2,ny-2
      tem2(   1,j,k)=tem2(   2,j,k)
      tem2(nx-1,j,k)=tem2(nx-2,j,k)
    END DO
  END DO

  DO k=1,nz-1
    DO i=1,nx-1
      tem2(i,   1,k)=tem2(i,   2,k)
      tem2(i,ny-1,k)=tem2(i,ny-2,k)
    END DO
  END DO

  node = 0
  DO k=kst,knd,ksk
    DO j=jst,jnd,jsk
      DO i=ist,ind,isk
        node = node + 1
        tem1(node) = tem2(i,j,k)
      END DO
    END DO
  END DO

  CALL mwritescalararrayi (gridid, vortid,1,nxout,                      &
                           1,nyout,1,nzout,tem1,ierr)
  IF ( ierr == meerr ) THEN
    CALL mgeterror (errorstring)
    PRINT*, 'Error: Unable to write scalar. VortID=', vortid
    PRINT*, 'Error Message: ',errorstring
  END IF

!
!  Divergernce:
!
  DO k=1,nz-1
    DO j=1,ny-1
      DO i=1,nx-1
        tem2(i,j,k)=                                                    &
            (u(i+1,j,k)-u(i,j,k))/(x(i+1)-x(i))+                        &
            (v(i,j+1,k)-v(i,j,k))/(y(j+1)-y(j))
      END DO
    END DO
  END DO

  node = 0
  DO k=kst,knd,ksk
!   DO 4200 i=ist,ind,isk
    DO j=jst,jnd,jsk
      DO i=ist,ind,isk
        node = node + 1
        tem1(node) = tem2(i,j,k)
      END DO
    END DO
  END DO

  CALL mwritescalararrayi (gridid, divid,1,nxout,                       &
                           1,nyout,1,nzout,tem1,ierr)
  IF ( ierr == meerr ) THEN
    CALL mgeterror (errorstring)
    PRINT*, 'Error: Unable to write scalar. DivID=', divid
    PRINT*, 'Error Message: ',errorstring
  END IF

  CALL mendcurrentframew (gridid, ierr)

  gbwrtn = 1 ! This routine has been called once.

  RETURN

  ENTRY sdmpdomn(ist1,ind1,jst1,jnd1,kst1,knd1)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  To set the start and end indicies of the model subdomain
!  in which the data is dumped out.
!
!-----------------------------------------------------------------------
!
  ist = ist1
  jst = jst1
  kst = kst1
  ind = ind1
  jnd = jnd1
  knd = knd1

  setdomn = 1

  PRINT*,'setdomn in sdmpdomn',     setdomn

  RETURN

  ENTRY sdmpskip(isk1, jsk1, ksk1)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  To set data skip parameters for data dump.
!
!-----------------------------------------------------------------------
!

  isk = isk1
  jsk = jsk1
  ksk = ksk1

  setskip = 1

  RETURN
END SUBROUTINE svidump
!
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE GWRISCALARARRAY            ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!
!  SUBROUTINE GWriScalarArray(gridh,variable_name,input_array,nxyz)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Handles the call to Savi3D routine GrafWriteScalarArray
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Ming Xue
!  01/28/1993
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------


!   implicit none

!   integer gridh
!   character variable_name*(*)
!   integer nxyz
!   real    input_array(nxyz)
!   integer ierr

!   CALL GrafWriteScalarArray(gridh,variable_name,input_array,ierr)

!   RETURN
!
  END