!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE V3DDUMP                    ######
!######                                                      ######
!######                     Developed by                     ######
!######     Coastal Meteorology Research Project  (CMRP)     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE v5ddump(nx,ny,nz,nstyps, filnam, istgr,                      & 1,54
           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:
!
!  Write history data into the file "filnam" in the Vis5D format.
!
!  All output data are located at the grid cell centers.
!
!       X_center(i) = ( X_edge(i) + X_edge(i+1) )/2,  i = 1, n-1, 1
!
!  The last edge value were kept unchanged so that it can be used to
!  restore the stagger grid point values.
!
!       X_edge(n) = X_center(n)
!       X_edge(i) = 2*X_center(i) - X_edge(i+1),      i = n-1, 1, -1
!
!  Since total and perturbation variables will be dumped, the base
!  state variables can be obtained by Xbar = X - Xprt.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Fanyou kong
!  4/28/97.
!
!  1/31/2002 (Ming Xue)
!  Fixed a problem that occurs when nstyp>1.
!
!-----------------------------------------------------------------------
!
!  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
!
!    nstyps   number of soil types
!
!    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)
!    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
!    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
!
!  OUTPUT:
!
!    None.
!
!  WORK ARRAY:
!
!    tem1     Temporary work array. Used to store data for Vis5D
!             write function, which has different order of nx,ny
!    tem2     Temporary work array.
!
!
!-----------------------------------------------------------------------
!
!  The following parameters are passed into this subroutine through
!  a common block in globcst.inc, and they determine which
!  variables are output.
!
!  varout =0 or 1. If varout=0, model perturbation variables are not
!                  dumped.
!  mstout =0 or 1. If mstout=0, water variables are not dumped.
!  rainout=0 or 1. If rainout=0, rain variables are not dumped.
!  prcout =0 or 1. If prcout=0, precipitation rates are not dumped.
!  iceout =0 or 1. If iceout=0, qi, qs and qh are not dumped.
!  tkeout =0 or 1. If tkeout=0, tke is not dumped.
!  trbout =0 or 1. If trbout=0, kmh and kmv are not dumped
!  sfcout =0 or 1. If sfcout=0, surface variables are not dumped.
!  landout=0 or 1. If landout=0, surface property arrays are not dumped.
!  radout =0 or 1. If radout=0, radiation arrays are not dumped.
!  flxout =0 or 1. If flxout=0, precipitation rates are not dumped.
!
!-----------------------------------------------------------------------
!
!  Variable Declarations.
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
  INCLUDE 'v5df.inc'

  INTEGER :: nx,ny,nz          ! Number of grid points in 3 directions

  INTEGER :: istgr           ! Flag for dumping stager point data

  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)           ! x-coord. of the physical and
                               ! computational grid. Defined at u-point.
  REAL :: y     (ny)           ! y-coord. of the physical and
                               ! computational grid. Defined at v-point.
  REAL :: z     (nz)           ! z-coord. of the computational grid.
                               ! Defined at w-point on the staggered grid.
  REAL :: zp    (nx,ny,nz)     ! 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
                               ! ddefined as ( zp )/d( z )

  INTEGER :: nstyps
  INTEGER :: soiltyp(nx,ny,nstyps)    ! Soil type
  REAL :: stypfrct(nx,ny,nstyps)   ! Fraction of soil types
  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)
                                      ! (in top 1 cm layer)
  REAL :: tsoil  (nx,ny,0:nstyps)     ! Deep soil temperature (K)
                                      ! (in deep 1 m layer)
  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  (ny,nx,nz)            ! Temporary work array (note the
                                      ! order of indexes)
  REAL :: tem2  (nx,ny,nz)            ! Temporary work array

!
!-----------------------------------------------------------------------
!
  INTEGER :: i,j,k
  INTEGER :: m, l
  INTEGER :: ierr,is, it,iv, nl(maxvars),nr,nc, maxnl
  INTEGER :: varnum,numtimes
  INTEGER :: dates(maxtimes),times(maxtimes)

  INTEGER :: compressmode

  CHARACTER (LEN=*) :: filnam
  CHARACTER (LEN=10) :: varnam(maxvars)
  CHARACTER (LEN=20) :: chrstr

  REAL :: proj_args(100)
  REAL :: vert_args(maxlevels)

  INTEGER :: projection
  INTEGER :: vertical

  REAL :: latnot(2), x0,y0
  REAL :: xbgn,ybgn,zbgn,xinc,yinc,zinc,xmin,xmax,ymin,ymax
  INTEGER :: yy,date0,time0,idatime,hh,mm,ss

  INTEGER :: mndys(12)                 ! days for each months
  DATA mndys/0,31,59,90,120,151,181,212,243,273,304,334/
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
  INCLUDE 'globcst.inc'
  INCLUDE 'grid.inc'
!
!-----------------------------------------------------------------------

  DATA numtimes/1/
  DATA varnam(1) /'ZP'/
  DATA compressmode/1/
!
!-----------------------------------------------------------------------
!
!  Calculate time and grid parameters
!
!-----------------------------------------------------------------------
!
  varnum = 1

  yy = year - 100*(year/100)
  date0 = 1000*yy + mndys(month) +day
  time0 = 10000*hour + 100*minute + second
  dates(1) = date0

  idatime = INT(curtim)
  hh = idatime/3600
  idatime = idatime - 3600*hh
  mm = idatime/60
  ss = idatime - 60*mm

  hh = hh + hour
  IF(hh > 24) THEN
    hh = hh - 24
    dates(1) = dates(1) + 1
  END IF

  times(1) = 10000*hh+100*mm+ss

  nr=ny
  nc=nx

  DO i=1, varnum
    nl(i) = nz
  END DO

  xbgn =  x(2)
  ybgn =  y(2)
  zbgn =  z(2)

  xinc = (x(2) - x(1))
  yinc = (y(2) - y(1))

  xmin = xbgn
  xmax = x(nx) + xinc
  ymin = ybgn
  ymax = y(ny) + yinc

!-----------------------------------------------------------------------
!
!   Determine projection parameters used in the program
!
!-----------------------------------------------------------------------

  IF(mapproj /= 0) THEN
    latnot(1) = trulat1
    latnot(2) = trulat2


    CALL getmapr(mapproj, sclfct, latnot,trulon,x0,y0)
    WRITE(6,*) 'mapproj, sclfct,trulat1,trulat2,trulon:'
    WRITE(6,*) mapproj, sclfct,trulat1,trulat2,trulon
    WRITE(6,*) 'ctrlat,ctrlon:',ctrlat,ctrlon
    WRITE(6,*) 'x0,y0:', x0,y0

    IF( trulon > 180.0) trulon = trulon - 360.0
    IF(-trulon > 180.0) trulon = trulon + 360.0
    trulon = -trulon

  END IF

  IF(mapproj > 2) THEN
    WRITE(6,*) 'mapproj=',mapproj,                                      &
              ' is not a supported map projection by Vis5D, STOP'
    CALL EXIT(1)
  END IF

  IF(mapproj == 0) THEN    ! Linear, rectangular, generic units

    projection = 0

    proj_args(1) = ymax
    proj_args(2) = xmin
    proj_args(3) = yinc
!      proj_args(4) = -xinc
    proj_args(4) = xinc

  ELSE IF (mapproj == 1) THEN ! Stereographic projection
                              ! In Vis5D only azimuthal stereographic
                              ! is supported, so the use of this
                              ! projection in ARPS data is only an
                              ! approximation which needs trulat1
                              ! not less than 75 degree

    IF(ABS(trulat1) < 75.0) THEN
      WRITE(6,*) 'trulat1=',trulat1,' is less than 75deg',              &
                 ' which may cause large error'
      WRITE(6,*) 'in polar stereographic projection mode, STOP'
      CALL EXIT(1)
    END IF

    projection = 3

    proj_args(1) = 90.0
    proj_args(2) = trulon
    proj_args(3) = y0/yinc + FLOAT(ny-2)
    proj_args(4) = -x0/xinc + 2.0
    proj_args(5) = xinc/1000.0

  ELSE IF (mapproj == 2) THEN ! Lambert conformal projection

    projection = 2

    IF(trulat1 >= trulat2) THEN
      proj_args(1) = trulat1
      proj_args(2) = trulat2
    ELSE
      proj_args(1) = trulat2
      proj_args(2) = trulat1
    END IF
    proj_args(3) = y0/yinc + FLOAT(ny-2)
    proj_args(4) = -x0/xinc + 1.0
    proj_args(5) = trulon
    proj_args(6) = xinc/1000.0

  END IF

  WRITE(6,*) (proj_args(i),i=1,6)

!-----------------------------------------------------------------------
!
!   Determine vertical coordinate parameters used in the program
!
!-----------------------------------------------------------------------

  vertical = 2                ! unequally spaced (km)

  zinc = (zp(1,1,2)-zp(1,1,1))/2.0
  DO k = 1,nz
    vert_args(k) = (zp(1,1,k)+zinc)/1000.0
  END DO

!     write(6,*) 'vertical:',vertical
!     write(6,*) 'vert_args(k):'
!     write(6,'(i10,f12.4/)') (k,vert_args(k),k=1,nz)

!-----------------------------------------------------------------------
!
!   Determine the output fields according to input switches
!
!-----------------------------------------------------------------------

  IF ( varout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'U'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'V'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'W'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'UPRT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'VPRT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'PT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'PTPRT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'P'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'PPRT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'VORT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'DIV'
    nl(varnum) = nz

  END IF

  IF ( mstout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'QV'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'QVPRT'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'QC'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'QR'
    nl(varnum) = nz

    IF ( iceout == 1 ) THEN

      varnum = varnum + 1
      varnam(varnum) = 'QI'
      nl(varnum) = nz

      varnum = varnum + 1
      varnam(varnum) = 'QS'
      nl(varnum) = nz

      varnum = varnum + 1
      varnam(varnum) = 'QH'
      nl(varnum) = nz

    END IF

    IF ( rainout == 1 ) THEN

      varnum = varnum + 1
      varnam(varnum) = 'RAING'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'RAINC'
      nl(varnum) = 1

    END IF

    IF ( prcout == 1 ) THEN

      varnum = varnum + 1
      varnam(varnum) = 'PRCRATE1'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'PRCRATE2'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'PRCRATE3'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'PRCRATE4'
      nl(varnum) = 1

    END IF
  END IF

  IF ( tkeout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'TKE'
    nl(varnum) = nz

  END IF

  IF ( trbout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'KMH'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'KMV'
    nl(varnum) = nz

  END IF

  IF ( sfcout == 1 ) THEN

    IF ( nstyp <= 1 ) THEN

      varnum = varnum + 1
      varnam(varnum) = 'TS'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'T2'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'WG'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'W2'
      nl(varnum) = 1

      varnum = varnum + 1
      varnam(varnum) = 'WR'
      nl(varnum) = 1

    ELSE

      DO is=0,nstyp
        WRITE (chrstr,'(i1)') is

        varnum = varnum + 1
        varnam(varnum) = 'TS'//chrstr(1:1)
        nl(varnum) = 1

        varnum = varnum + 1
        varnam(varnum) = 'T2'//chrstr(1:1)
        nl(varnum) = 1

        varnum = varnum + 1
        varnam(varnum) = 'WG'//chrstr(1:1)
        nl(varnum) = 1

        varnum = varnum + 1
        varnam(varnum) = 'W2'//chrstr(1:1)
        nl(varnum) = 1

        varnum = varnum + 1
        varnam(varnum) = 'WR'//chrstr(1:1)
        nl(varnum) = 1

      END DO

    END IF

    varnum = varnum + 1
    varnam(varnum) = 'SC'
    nl(varnum) = 1

  END IF

  IF(landout == 1) THEN

    IF (nstyp <= 1) THEN

      varnum = varnum + 1
      varnam(varnum) = 'SOILTY'
      nl(varnum) = 1

    ELSE
      DO is=1,nstyp
        WRITE (chrstr,'(i1)') is

        varnum = varnum + 1
        varnam(varnum) = 'SOILTY'//chrstr(1:1)
        nl(varnum) = 1

        varnum = varnum + 1
        varnam(varnum) = 'SOILFR'//chrstr(1:1)
        nl(varnum) = 1

      END DO
    END IF

    varnum = varnum + 1
    varnam(varnum) = 'VEGTYP'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'LAI'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'ROUFNS'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'VEG'
    nl(varnum) = 1

  END IF

  IF ( radout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'RADFRC'
    nl(varnum) = nz

    varnum = varnum + 1
    varnam(varnum) = 'RADSW'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'RNFLX'
    nl(varnum) = 1

  END IF

  IF ( flxout == 1 ) THEN

    varnum = varnum + 1
    varnam(varnum) = 'USFLX'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'VSFLX'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'PTSFLX'
    nl(varnum) = 1

    varnum = varnum + 1
    varnam(varnum) = 'QVSFLX'
    nl(varnum) = 1

  END IF

  WRITE(6,*) 'Number of variables to be written: ',varnum

!----------------------------------------------------------------------
!
!  Open Vis5D file & write header to it
!
!-----------------------------------------------------------------------

  m = v5dcreate (filnam, numtimes, varnum, nr, nc, nl,                  &
                 varnam, times, dates, compressmode,                    &
                 projection, proj_args, vertical, vert_args)

  IF (m == 0) THEN
    CALL EXIT(1)
  END IF

  maxnl = nl(1)
  DO i = 1, varnum
    IF(nl(i) > maxnl) THEN
      maxnl = nl(i)
    END IF
  END DO

!----------------------------------------------------------------------
!
!  Output data to Vis5D file
!
!-----------------------------------------------------------------------

  DO it = 1, numtimes
    DO iv = 1, varnum
      DO k=1,nz
        DO i=1,nx
          DO j=1,ny
            tem1(j,i,k) = 0.0
            tem2(i,j,k) = 0.0
          END DO
        END DO
      END DO

      IF(varnam(iv) == 'ZP') THEN
        CALL v5dsetunits(iv, "m\0")
        CALL edgfill(zp  ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz)

        IF ( istgr == 0 ) THEN
          DO j=1,ny
            DO i=1,nx
              DO k=1,nz-1
                tem2(i,j,k) = .5 * ( zp(i,j,k) + zp(i,j,k+1) )
              END DO
              tem2(i,j,nz) = zp(i,j,nz)
            END DO
          END DO
        ELSE
          DO j=1,ny
            DO i=1,nx
              DO k=1,nz
                tem2(i,j,k) = zp(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'U') THEN
        CALL v5dsetunits(iv, "m/s\0")
        CALL edgfill(u,   1,nx,1,nx, 1,ny,1,ny-1, 1,nz,1,nz-1)

        IF ( istgr == 0 ) THEN
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx-1
                tem2(i,j,k) = .5 * ( u(i,j,k) + u(i+1,j,k) )
              END DO
              tem2(nx,j,k) = u(nx,j,k)
            END DO
          END DO
        ELSE
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx
                tem2(i,j,k) = u(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'V') THEN
        CALL v5dsetunits(iv, "m/s\0")
        CALL edgfill(v,   1,nx,1,nx-1, 1,ny,1,ny, 1,nz,1,nz-1)

        IF ( istgr == 0 ) THEN
          DO k=1,nz
            DO i=1,nx
              DO j=1,ny-1
                tem2(i,j,k) = .5 * ( v(i,j,k) + v(i,j+1,k) )
              END DO
              tem2(i,ny,k) = v(i,ny,k)
            END DO
          END DO
        ELSE
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx
                tem2(i,j,k) = v(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'UPRT') THEN
        CALL v5dsetunits(iv, "m/s\0")
        CALL edgfill(ubar,1,nx,1,nx, 1,ny,1,ny-1, 1,nz,1,nz-1)

        IF ( istgr == 0 ) THEN
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx-1
                tem2(i,j,k) = .5 * ( u(i,j,k) + u(i+1,j,k) )            &
                            - .5 * ( ubar(i,j,k) + ubar(i+1,j,k) )
              END DO
              tem2(nx,j,k) = u(nx,j,k) - ubar(nx,j,k)
            END DO
          END DO
        ELSE
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx
                tem2(i,j,k) = u(i,j,k) - ubar(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'VPRT') THEN
        CALL v5dsetunits(iv, "m/s\0")
        CALL edgfill(vbar,1,nx,1,nx-1, 1,ny,1,ny, 1,nz,1,nz-1)

        IF ( istgr == 0 ) THEN
          DO k=1,nz
            DO i=1,nx
              DO j=1,ny-1
                tem2(i,j,k) = .5 * ( v(i,j,k) + v(i,j+1,k) )            &
                            - .5 * ( vbar(i,j,k) + vbar(i,j+1,k) )
              END DO
              tem2(i,ny,k) = v(i,ny,k) - vbar(i,ny,k)
            END DO
          END DO
        ELSE
          DO k=1,nz
            DO j=1,ny
              DO i=1,nx
                tem2(i,j,k) = v(i,j,k) - vbar(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'W') THEN
        CALL v5dsetunits(iv, "m/s\0")
        CALL edgfill(w   ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz)

        IF ( istgr == 0 ) THEN
          DO j=1,ny
            DO i=1,nx
              DO k=1,nz-1
                tem2(i,j,k) = .5 * ( w(i,j,k) + w(i,j,k+1) )
              END DO
              tem2(i,j,nz) = w(i,j,nz)
            END DO
          END DO
        ELSE
          DO j=1,ny
            DO i=1,nx
              DO k=1,nz
                tem2(i,j,k) = w(i,j,k)
              END DO
            END DO
          END DO
        END IF

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PT') THEN
        CALL v5dsetunits(iv, "K\0")
        CALL edgfill(ptprt,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        CALL edgfill(ptbar,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = ptprt(i,nr-j+1,k)+ptbar(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PTPRT') THEN
        CALL v5dsetunits(iv, "K\0")
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = ptprt(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'P') THEN
        CALL v5dsetunits(iv, "mb\0")
        CALL edgfill(pprt,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        CALL edgfill(pbar,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 0.01*(pprt(i,nr-j+1,k)+pbar(i,nr-j+1,k))
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PPRT') THEN
        CALL v5dsetunits(iv, "mb\0")
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 0.01*pprt(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'VORT') THEN
        CALL v5dsetunits(iv, "1/s\0")
        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

        CALL edgfill(tem2,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)

        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'DIV') THEN
        CALL v5dsetunits(iv, "1/s\0")
        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

        CALL edgfill(tem2,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tem2(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QV') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qv,   1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qv(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QVPRT') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qvbar,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*(qv(i,nr-j+1,k) - qvbar(i,j,k))
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QC') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qc,   1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qc(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QR') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qr,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qr(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QI') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qi,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qi(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QS') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qs,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qs(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'QH') THEN
        CALL v5dsetunits(iv, "g/kg\0")
        CALL edgfill(qh,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = 1000.*qh(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'RAING') THEN
        CALL v5dsetunits(iv, "mm\0")
        CALL edgfill(raing,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = raing(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'RAINC') THEN
        CALL v5dsetunits(iv, "mm\0")
        CALL edgfill(rainc,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = rainc(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PRCRATE1') THEN
        CALL v5dsetunits(iv, "kg/m**2/s\0")
        CALL edgfill(prcrate(1,1,1),1,nx,1,nx-1,1,ny,1,ny-1,1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = prcrate(i,nr-j+1,1)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PRCRATE2') THEN
        CALL v5dsetunits(iv, "kg/m**2/s\0")
        CALL edgfill(prcrate(1,1,2),1,nx,1,nx-1,1,ny,1,ny-1,1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = prcrate(i,nr-j+1,2)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PRCRATE3') THEN
        CALL edgfill(prcrate(1,1,3),1,nx,1,nx-1,1,ny,1,ny-1,1,1,1,1)
        CALL v5dsetunits(iv, "kg/m**2/s\0")
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = prcrate(i,nr-j+1,3)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'PRCRATE4') THEN
        CALL v5dsetunits(iv, "kg/m**2/s\0")
        CALL edgfill(prcrate(1,1,4),1,nx,1,nx-1,1,ny,1,ny-1,1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = prcrate(i,nr-j+1,4)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'TKE') THEN
        CALL v5dsetunits(iv, "m**2/s\0")
        CALL edgfill(tke,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = tke(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'KMH') THEN
        CALL v5dsetunits(iv, "m**2/s\0")
        CALL edgfill(kmh,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = kmh(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF(varnam(iv) == 'KMV') THEN
        CALL v5dsetunits(iv, "m**2/s\0")
        CALL edgfill(kmv,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = kmv(i,nr-j+1,k)
            END DO
          END DO
        END DO

      END IF

      IF ( sfcout == 1 ) THEN

        IF (nstyp <= 1) THEN

          IF(varnam(iv) == 'TS') THEN
            CALL v5dsetunits(iv, "K\0")
            CALL edgfill(tsfc(1,1,0),   1,nx,1,nx-1, 1,ny,1,ny-1,       &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = tsfc(i,nr-j+1,0)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv) == 'T2') THEN
            CALL v5dsetunits(iv, "K\0")
            CALL edgfill(tsoil(1,1,0),   1,nx,1,nx-1, 1,ny,1,ny-1,      &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = tsoil(i,nr-j+1,0)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv) == 'WG') THEN
            CALL v5dsetunits(iv, "m**3/m**3\0")
            CALL edgfill(wetsfc(1,1,0),   1,nx,1,nx-1, 1,ny,1,ny-1,     &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetsfc(i,nr-j+1,0)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv) == 'W2') THEN
            CALL v5dsetunits(iv, "m**3/m**3\0")
            CALL edgfill(wetdp(1,1,0),   1,nx,1,nx-1, 1,ny,1,ny-1,      &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetdp(i,nr-j+1,0)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv) == 'WR') THEN
            CALL v5dsetunits(iv, "m\0")
            CALL edgfill(wetcanp(1,1,0),   1,nx,1,nx-1, 1,ny,1,ny-1,    &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetcanp(i,nr-j+1,0)
                END DO
              END DO
            END DO

          END IF

        ELSE

          IF(varnam(iv)(1:2) == 'TS') THEN
            READ(varnam(iv)(3:3), '(i1)') l
            CALL v5dsetunits(iv, "K\0")
            CALL edgfill(tsfc(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,       &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = tsfc(i,nr-j+1,l)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv)(1:2) == 'T2') THEN
            READ(varnam(iv)(3:3), '(i1)') l
            CALL v5dsetunits(iv, "K\0")
            CALL edgfill(tsoil(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,      &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = tsoil(i,nr-j+1,l)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv)(1:2) == 'WG') THEN
            READ(varnam(iv)(3:3), '(i1)') l
            CALL v5dsetunits(iv, "m**3/m**3\0")
            CALL edgfill(wetsfc(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,     &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetsfc(i,nr-j+1,l)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv)(1:2) == 'W2') THEN
            READ(varnam(iv)(3:3), '(i1)') l
            CALL v5dsetunits(iv, "m**3/m**3\0")
            CALL edgfill(wetdp(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,      &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetdp(i,nr-j+1,l)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv)(1:2) == 'WR') THEN
            READ(varnam(iv)(3:3), '(i1)') l
            CALL v5dsetunits(iv, "m\0")
            CALL edgfill(wetcanp(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,    &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = wetcanp(i,nr-j+1,l)
                END DO
              END DO
            END DO

          END IF

        END IF

        IF(snowout == 1) THEN
          IF (varnam(iv)(1:2) == 'SD') THEN
            CALL v5dsetunits(iv, "index\0")
            CALL edgfill(snowdpth,1,nx,1,nx-1, 1,ny,1,ny-1,1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = snowdpth(i,nr-j+1)
                END DO
              END DO
            END DO
          END IF
        END IF

      END IF       ! End sfcout

      IF(landout == 1) THEN

        IF (nstyp <= 1) THEN

          IF(varnam(iv) == 'SOILTY') THEN
            CALL v5dsetunits(iv, "index\0")
            CALL iedgfill(soiltyp(1,1,1),1,nx,1,nx-1, 1,ny,1,ny-1,      &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = soiltyp(i,nr-j+1,1)
                END DO
              END DO
            END DO
          END IF

        ELSE

          IF(varnam(iv)(1:6) == 'SOILTY') THEN
            READ(varnam(iv)(7:7), '(i1)') l
            CALL v5dsetunits(iv, "index\0")
            CALL edgfill(soiltyp(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,    &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = soiltyp(i,nr-j+1,l)
                END DO
              END DO
            END DO

          ELSE IF(varnam(iv)(1:6) == 'SOILFR') THEN
            READ(varnam(iv)(7:7), '(i1)') l
            CALL v5dsetunits(iv, "fraction\0")
            CALL edgfill(stypfrct(1,1,l),   1,nx,1,nx-1, 1,ny,1,ny-1,   &
                         1,1,1,1)
            DO k=1,nl(iv)
              DO i=1,nc
                DO j=1,nr
                  tem1(j,i,k) = stypfrct(i,nr-j+1,l)
                END DO
              END DO
            END DO

          END IF

        END IF

        IF(varnam(iv) == 'VEGTYP') THEN
          CALL v5dsetunits(iv, "index\0")
          CALL iedgfill(vegtyp ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
          DO k=1,nl(iv)
            DO i=1,nc
              DO j=1,nr
                tem1(j,i,k) = vegtyp(i,nr-j+1)
              END DO
            END DO
          END DO

        ELSE IF(varnam(iv) == 'LAI') THEN
          CALL edgfill(lai ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
          DO k=1,nl(iv)
            DO i=1,nc
              DO j=1,nr
                tem1(j,i,k) = lai(i,nr-j+1)
              END DO
            END DO
          END DO

        ELSE IF(varnam(iv) == 'ROUFNS') THEN
          CALL v5dsetunits(iv, "m\0")
          CALL edgfill(roufns ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
          DO k=1,nl(iv)
            DO i=1,nc
              DO j=1,nr
                tem1(j,i,k) = roufns(i,nr-j+1)
              END DO
            END DO
          END DO

        ELSE IF(varnam(iv) == 'VEG') THEN
          CALL v5dsetunits(iv, "fraction\0")
          CALL edgfill(veg ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
          DO k=1,nl(iv)
            DO i=1,nc
              DO j=1,nr
                tem1(j,i,k) = veg(i,nr-j+1)
              END DO
            END DO
          END DO
        END IF

      END IF     ! End landout

      IF ( varnam(iv) == 'RADFRC' ) THEN
        CALL v5dsetunits(iv, "K/s\0")
        CALL edgfill(radfrc ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,nz,1,nz-1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = radfrc(i,nr-j+1,k)
            END DO
          END DO
        END DO

      ELSE IF ( varnam(iv) == 'RADSW' ) THEN
        CALL v5dsetunits(iv, "W/m**2\0")
        CALL edgfill(radsw ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = radsw(i,nr-j+1)
            END DO
          END DO
        END DO
      ELSE IF ( varnam(iv) == 'RNFLX' ) THEN
        CALL v5dsetunits(iv, "W/m**2\0")
        CALL edgfill(rnflx ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = rnflx(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF ( varnam(iv) == 'USFLX' ) THEN
        CALL v5dsetunits(iv, "kg/(m*s**2)\0")
        CALL edgfill(usflx ,1,nx,1,nx, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = usflx(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF ( varnam(iv) == 'VSFLX' ) THEN
        CALL v5dsetunits(iv, "kg/(m*s**2)\0")
        CALL edgfill(vsflx ,1,nx,1,nx-1, 1,ny,1,ny, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = vsflx(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF ( varnam(iv) == 'PTSFLX' ) THEN
        CALL v5dsetunits(iv, "K*kg/(m**2*s)\0")
        CALL edgfill(ptsflx ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = ptsflx(i,nr-j+1)
            END DO
          END DO
        END DO

      ELSE IF ( varnam(iv) == 'QVSFLX' ) THEN
        CALL v5dsetunits(iv, "kg/(m**2*s)\0")
        CALL edgfill(qvsflx ,1,nx,1,nx-1, 1,ny,1,ny-1, 1,1,1,1)
        DO k=1,nl(iv)
          DO i=1,nc
            DO j=1,nr
              tem1(j,i,k) = qvsflx(i,nr-j+1)
            END DO
          END DO
        END DO

      END IF

      m = v5dwrite(it,iv,tem1)
      IF(m == 0) THEN
        CALL EXIT(1)
      END IF

    END DO   ! enddo of iv
  END DO   ! enddo of it
!
!----------------------------------------------------------------------
!
!  End of putput, close the file & return
!
!-----------------------------------------------------------------------

  m = v5dclose()
  IF(m == 0) THEN
    CALL EXIT(1)
  END IF

  RETURN
END SUBROUTINE v5ddump