PROGRAM arpsprt,30
!
!##################################################################
!##################################################################
!######                                                      ######
!######                   PROGRAM ARPSPRT                    ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Program to examine ARPS grids that have been saved as
!  history files.  This prints out the variables to a file or
!  screen.
!
!  It shares with the model the include files  'globcst.inc'
!  for storage parameters.
!
!  It reads in a history file produced by ARPS 3.0 in a user
!  specified format.
!
!  Parameters grdin,basin,mstin,icein,trbin are read in from the
!  data file itself, therefore are determined internally.
!  Arrays that are not read in retain their initial zero values.
!  These parameters are passed among subroutines through
!  a common block defined in 'indtflg.inc'.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster  OU School of Meteorology. April 1992
!
!  MODIFICATION HISTORY:
!   14 May 1992  (KB) changed from arps2.5 to arps3.0
!   03 Aug 1992  (KB) updated to account for changes in arps3.0
!
!   8/27/1992 (M. Xue)
!   To call dtaread to read new data format.
!
!   8/30/1992 (K. Brewster)
!   Moved label 101 so that grid file name is not reentered for
!   second and subsequent data reads.
!
!   9/1/94 (Y. Lu)
!   Cleaned up documentation.
!
!   10/11/1994 (K. Brewster)
!   Further update for dtaread.
!
!-----------------------------------------------------------------------
!
!  DATA ARRAYS READ IN:
!
!    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 (km)
!    zp       z coordinate of grid points in computational space (m)
!
!    uprt     x component of perturbation velocity (m/s)
!    vprt     y component of perturbation velocity (m/s)
!    wprt     Vertical component of perturbation velocity in Cartesian
!             coordinates (m/s).
!
!    ptprt    Perturbation potential temperature (K)
!    pprt     Perturbation pressure (Pascal)
!
!    qvprt    Perturbation water vapor mixing ratio (kg/kg)
!    qc       Cloud water mixing ratio (kg/kg)
!    qr       Rainwater mixing ratio (kg/kg)
!    qi       Cloud ice mixing ratio (kg/kg)
!    qs       Snow mixing ratio (kg/kg)
!    qh       Hail mixing ratio (kg/kg)
!
!    ubar     Base state x velocity component (m/s)
!    vbar     Base state y velocity component (m/s)
!    wbar     Base state z velocity component (m/s)
!    ptbar    Base state potential temperature (K)
!    pbar     Base state pressure (Pascal)
!    rhobar   Base state air density (kg/m**3)
!    qvbar    Base state water vapor mixing ratio (kg/kg)
!
!  CALCULATED DATA ARRAYS:
!
!    u        x component of velocity (m/s)
!    v        y component of velocity (m/s)
!    w        z component of velocity (m/s)
!    pt       Potential temperature (K)
!    qv       Water vapor mixing ratio (kg/kg)
!
!
!  WORK ARRAYS:
!
!    tem1     Temporary work array.
!    tem2     Temporary work array.
!
!
!-----------------------------------------------------------------------
!
!  Variable Declarations:
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
  INTEGER :: nx,ny,nz

!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
  INCLUDE 'globcst.inc'
  INCLUDE 'indtflg.inc'
!
!-----------------------------------------------------------------------
!
!  Arrays to be read in:
!
!-----------------------------------------------------------------------
!

  REAL, ALLOCATABLE :: x     (:)         ! The x-coord. of the physical and
                                         ! computational grid. Defined at u-point.
  REAL, ALLOCATABLE :: y     (:)         ! The y-coord. of the physical and
                                         ! computational grid. Defined at v-point.
  REAL, ALLOCATABLE :: z     (:)         ! The z-coord. of the computational grid.
                                         ! Defined at w-point on the staggered grid.
  REAL, ALLOCATABLE :: zp    (:,:,:)     ! The physical height coordinate defined at
                                         ! w-point of the staggered grid.
  REAL, ALLOCATABLE :: j1    (:,:,:)     ! Coordinate transformation Jacobian defined
                                         ! as - d( zp )/d( x )
  REAL, ALLOCATABLE :: j2    (:,:,:)     ! Coordinate transformation Jacobian defined
                                         ! as - d( zp )/d( y )
  REAL, ALLOCATABLE :: j3    (:,:,:)     ! Coordinate transformation Jacobian defined
                                         ! as d( zp )/d( z )

  REAL, ALLOCATABLE :: u     (:,:,:)     ! Total u-velocity (m/s)
  REAL, ALLOCATABLE :: v     (:,:,:)     ! Total v-velocity (m/s)
  REAL, ALLOCATABLE :: w     (:,:,:)     ! Total w-velocity (m/s)
  REAL, ALLOCATABLE :: pt    (:,:,:)     ! Total potential temperature (K)

  REAL, ALLOCATABLE :: qv    (:,:,:)     ! Water vapor specific humidity (kg/kg)
  REAL, ALLOCATABLE :: qc    (:,:,:)     ! Cloud water mixing ratio (kg/kg)
  REAL, ALLOCATABLE :: qr    (:,:,:)     ! Rain water mixing ratio (kg/kg)
  REAL, ALLOCATABLE :: qi    (:,:,:)     ! Cloud ice mixing ratio (kg/kg)
  REAL, ALLOCATABLE :: qs    (:,:,:)     ! Snow mixing ratio (kg/kg)
  REAL, ALLOCATABLE :: qh    (:,:,:)     ! Hail mixing ratio (kg/kg)
  REAL, ALLOCATABLE :: tke   (:,:,:)     ! Turbulent Kinetic Energy ((m/s)**2)
  REAL, ALLOCATABLE :: kmh   (:,:,:)     ! Horizontal turb. mixing coef. for
                                         ! momentum. ( m**2/s )
  REAL, ALLOCATABLE :: kmv   (:,:,:)     ! Vertical turb. mixing coef. for
                                         ! momentum. ( m**2/s )
  REAL, ALLOCATABLE :: ubar  (:,:,:)     ! Base state u-velocity (m/s)
  REAL, ALLOCATABLE :: vbar  (:,:,:)     ! Base state v-velocity (m/s)
  REAL, ALLOCATABLE :: wbar  (:,:,:)     ! Base state w-velocity (m/s)
  REAL, ALLOCATABLE :: ptbar (:,:,:)     ! Base state potential temperature (K)
  REAL, ALLOCATABLE :: rhobar(:,:,:)     ! Base state air density (kg/m**3)
  REAL, ALLOCATABLE :: pbar  (:,:,:)     ! Base state pressure (Pascal)
  REAL, ALLOCATABLE :: qvbar (:,:,:)     ! Base state water vapor specific humidity
                                         ! (kg/kg)
  INTEGER :: nstyps
  PARAMETER (nstyps=4)

  INTEGER, ALLOCATABLE :: soiltyp (:,:,:)! Soil type
  REAL, ALLOCATABLE :: stypfrct(:,:,:)   ! Fraction of soil types
  INTEGER , ALLOCATABLE:: vegtyp  (:,:)  ! Vegetation type
  REAL, ALLOCATABLE :: lai     (:,:)     ! Leaf Area Index
  REAL, ALLOCATABLE :: roufns  (:,:)     ! Surface roughness
  REAL, ALLOCATABLE :: veg     (:,:)     ! Vegetation fraction

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

  REAL, ALLOCATABLE :: raing  (:,:)      ! Grid supersaturation rain
  REAL, ALLOCATABLE :: rainc  (:,:)      ! Cumulus convective rain
  REAL, ALLOCATABLE :: prcrate(:,:,:)    ! precipitation rate (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, ALLOCATABLE :: radfrc(:,:,:)     ! Radiation forcing (K/s)
  REAL, ALLOCATABLE :: radsw (:,:)       ! Solar radiation reaching the surface
  REAL, ALLOCATABLE :: rnflx (:,:)       ! Net radiation flux absorbed by surface

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

  REAL, ALLOCATABLE :: uprt  (:,:,:)     ! Perturbation u-velocity (m/s)
  REAL, ALLOCATABLE :: vprt  (:,:,:)     ! Perturbation v-velocity (m/s)
  REAL, ALLOCATABLE :: wprt  (:,:,:)     ! Perturbation w-velocity (m/s)
  REAL, ALLOCATABLE :: ptprt (:,:,:)     ! Perturbation potential temperature (K)
  REAL, ALLOCATABLE :: pprt  (:,:,:)     ! Perturbation pressure (Pascal)
  REAL, ALLOCATABLE :: qvprt (:,:,:)     ! Perturbation water vapor specific
                                         ! humidity (kg/kg)

!
!-----------------------------------------------------------------------
!
!  Other data variables
!
!-----------------------------------------------------------------------
!
  REAL :: time
!
!-----------------------------------------------------------------------
!
!  Temporary working arrays:
!
!-----------------------------------------------------------------------
!
  REAL, ALLOCATABLE :: tem1(:,:,:)
  REAL, ALLOCATABLE :: tem2(:,:,:)
  REAL, ALLOCATABLE :: tem3(:,:,:)
!
!-----------------------------------------------------------------------
!
!  User request stuff
!
!-----------------------------------------------------------------------
!
  CHARACTER (LEN=80) :: inline(5)
  INTEGER :: maxpar
  PARAMETER (maxpar=10)
  CHARACTER (LEN=2) :: params(maxpar)
  INTEGER :: islice(5),jslice(5),kslice(5)
  INTEGER :: nparams,ip
  INTEGER :: ireply(5)
  INTEGER :: nreply
!
!-----------------------------------------------------------------------
!
!  Misc internal variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: i,j,k,ireturn,mode,nm
!
  CHARACTER (LEN=80) :: filename
  CHARACTER (LEN=80) :: grdbasfn
  CHARACTER (LEN=25) :: title
  INTEGER :: lenfil,lengbf
!
  INTEGER :: iplot(3,5)
  INTEGER :: ib(3),ie(3),jb(3),je(3),kb(3),ke(3)
  INTEGER :: nchin

  INTEGER :: istatus

!-----------------------------------------------------------------------
!
!  NAMELIST definition
!
!-----------------------------------------------------------------------
  NAMELIST /grid_dims/ nx, ny, nz
  NAMELIST /input_fn/ hdmpfmt, grdbasfn, filename
  NAMELIST /field_number/ nreply
  NAMELIST /plot_options/ ireply, inline, iplot, kslice, jslice, islice
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  WRITE(6,'(/11(/5x,a)/)')                                              &
     '###############################################################', &
     '###############################################################', &
     '###                                                         ###', &
     '###                  Welcome to ARPSPRT                     ###', &
     '###      This program reads in the history dump data        ###', &
     '###      sets generated by ARPS, and prints the array       ###', &
     '###      contents as 2-D arrays tables at user specified    ###', &
     '###      slices.                                            ###', &
     '###                                                         ###', &
     '###############################################################', &
     '###############################################################'

  READ(5,grid_dims,END=100)                   !  read in the dimensions
  WRITE(6,'(/a,a)') 'Namelist block grid_dims successfully read.'

!-----------------------------------------------------------------------
!
!  Allocate variables and initialize to zero
!
!-----------------------------------------------------------------------
  ALLOCATE(  x=0
  ALLOCATE(  y=0
  ALLOCATE(  z=0
  ALLOCATE(zp(nx,ny,nz),STAT=istatus)
  zp=0
  ALLOCATE(j1(nx,ny,nz),STAT=istatus)
  j1=0
  ALLOCATE(j2(nx,ny,nz),STAT=istatus)
  j2=0
  ALLOCATE(j3(nx,ny,nz),STAT=istatus)
  j3=0
  ALLOCATE(  u=0
  ALLOCATE(  v=0
  ALLOCATE(  w=0
  ALLOCATE(pt(nx,ny,nz),STAT=istatus)
  pt=0
  ALLOCATE(qv(nx,ny,nz),STAT=istatus)
  qv=0
  ALLOCATE(qc(nx,ny,nz),STAT=istatus)
  qc=0
  ALLOCATE(qr(nx,ny,nz),STAT=istatus)
  qr=0
  ALLOCATE(qi(nx,ny,nz),STAT=istatus)
  qi=0
  ALLOCATE(qs(nx,ny,nz),STAT=istatus)
  qs=0
  ALLOCATE(qh(nx,ny,nz),STAT=istatus)
  qh=0
  ALLOCATE(tke(nx,ny,nz),STAT=istatus)
  tke=0
  ALLOCATE(kmh(nx,ny,nz),STAT=istatus)
  kmh=0
  ALLOCATE(kmv(nx,ny,nz),STAT=istatus)
  kmv=0
  ALLOCATE(ubar(nx,ny,nz),STAT=istatus)
  ubar=0
  ALLOCATE(vbar(nx,ny,nz),STAT=istatus)
  vbar=0
  ALLOCATE(wbar(nx,ny,nz),STAT=istatus)
  wbar=0
  ALLOCATE(ptbar(nx,ny,nz),STAT=istatus)
  ptbar=0
  ALLOCATE(rhobar(nx,ny,nz),STAT=istatus)
  rhobar=0
  ALLOCATE(pbar(nx,ny,nz),STAT=istatus)
  pbar=0
  ALLOCATE(qvbar(nx,ny,nz),STAT=istatus)
  qvbar=0
  ALLOCATE(soiltyp(nx,ny,nstyps),STAT=istatus)
  soiltyp=0
  ALLOCATE(stypfrct(nx,ny,nstyps),STAT=istatus)
  stypfrct=0
  ALLOCATE(vegtyp(nx,ny),STAT=istatus)
  vegtyp=0
  ALLOCATE(lai(nx,ny),STAT=istatus)
  lai=0
  ALLOCATE(roufns(nx,ny),STAT=istatus)
  roufns=0
  ALLOCATE(veg(nx,ny),STAT=istatus)
  veg=0
  ALLOCATE(tsfc(nx,ny,0:nstyps),STAT=istatus)
  tsfc=0
  ALLOCATE(tsoil(nx,ny,0:nstyps),STAT=istatus)
  tsoil=0
  ALLOCATE(wetsfc(nx,ny,0:nstyps),STAT=istatus)
  wetsfc=0
  ALLOCATE(wetdp(nx,ny,0:nstyps),STAT=istatus)
  wetdp=0
  ALLOCATE(wetcanp(nx,ny,0:nstyps),STAT=istatus)
  wetcanp=0
  ALLOCATE(snowdpth(nx,ny),STAT=istatus)
  snowdpth=0
  ALLOCATE(raing(nx,ny),STAT=istatus)
  raing=0
  ALLOCATE(rainc(nx,ny),STAT=istatus)
  rainc=0
  ALLOCATE(prcrate(nx,ny,4),STAT=istatus)
  prcrate=0
  ALLOCATE(radfrc(nx,ny,nz),STAT=istatus)
  radfrc=0
  ALLOCATE(radsw(nx,ny),STAT=istatus)
  radsw=0
  ALLOCATE(rnflx(nx,ny),STAT=istatus)
  rnflx=0
  ALLOCATE(usflx(nx,ny),STAT=istatus)
  usflx=0
  ALLOCATE(vsflx(nx,ny),STAT=istatus)
  vsflx=0
  ALLOCATE(ptsflx(nx,ny),STAT=istatus)
  ptsflx=0
  ALLOCATE(qvsflx(nx,ny),STAT=istatus)
  qvsflx=0
  ALLOCATE(uprt(nx,ny,nz),STAT=istatus)
  uprt=0
  ALLOCATE(vprt(nx,ny,nz),STAT=istatus)
  vprt=0
  ALLOCATE(wprt(nx,ny,nz),STAT=istatus)
  wprt=0
  ALLOCATE(ptprt(nx,ny,nz),STAT=istatus)
  ptprt=0
  ALLOCATE(pprt(nx,ny,nz),STAT=istatus)
  pprt=0
  ALLOCATE(qvprt(nx,ny,nz),STAT=istatus)
  qvprt=0
  ALLOCATE(tem1(nx,ny,nz),STAT=istatus)
  tem1=0
  ALLOCATE(tem2(nx,ny,nz),STAT=istatus)
  tem2=0
  ALLOCATE(tem3(nx,ny,nz),STAT=istatus)
  tem3=0
!
!-----------------------------------------------------------------------
!
!  A few initializations
!
!-----------------------------------------------------------------------

  DO mode=1,3
    ib(mode)=2
    ie(mode)=nx-2
    jb(mode)=2
    je(mode)=ny-2
    kb(mode)=2
    ke(mode)=nz-2
  END DO

!
!-----------------------------------------------------------------------
!
!  Get the name of the input data set.
!
!-----------------------------------------------------------------------
!
  READ(5,input_fn,END=100)
  WRITE(6,'(/a,a)')' Namelist block input_fn successfully read.'

  lengbf=LEN_trim(grdbasfn)
  lenfil=LEN_trim(filename)
  WRITE(6,'(/a,a)')' The data set name is ', filename(1:lenfil)

!
!-----------------------------------------------------------------------
!
!  Read all input data arrays
!
!-----------------------------------------------------------------------
!
  CALL dtaread(nx,ny,nz,nstyps,                                         &
               hdmpfmt,nchin,grdbasfn(1:lengbf),lengbf,                 &
               filename(1:lenfil),lenfil,time,                          &
               x,y,z,zp, uprt ,vprt ,wprt ,ptprt, pprt ,                &
               qvprt, qc, qr, qi, qs, qh, tke,kmh,kmv,                  &
               ubar, vbar, wbar, ptbar, pbar, rhobar, qvbar,            &
               soiltyp,stypfrct,vegtyp,lai,roufns,veg,                  &
               tsfc,tsoil,wetsfc,wetdp,wetcanp,snowdpth,                &
               raing,rainc,prcrate,                                     &
               radfrc,radsw,rnflx,                                      &
               usflx,vsflx,ptsflx,qvsflx,                               &
               ireturn, tem1,tem2,tem3)

  curtim = time
!
!-----------------------------------------------------------------------
!
!  ireturn = 0 for a successful read
!
!-----------------------------------------------------------------------
!
  IF( ireturn == 0 ) THEN   ! successful read
    
!-----------------------------------------------------------------------
!
! Determine how many variables to process
!
!-----------------------------------------------------------------------
 
  READ(5,field_number,END=100)
  WRITE(6,'(/a,a)') 'Namelist block field_number successfully read.'

!
!-----------------------------------------------------------------------
!
!  Determine variables to plot
!
!-----------------------------------------------------------------------
!
  
  READ(5,plot_options,END=100)
  WRITE(6,'(/a,a)') 'Namelist block plot_options successfully read.'


  DO nm=1,nreply
    IF( ireply(nm) /= 1) THEN

      CALL strcap(inline(nm),inline(nm),80)
      WRITE(6,'(a,/a80)') '  inline: ',inline(nm)
      CALL parsln(inline(nm),params,80,maxpar,nparams)

      WRITE(6,'(a,i4,a,20a)')                                           &
          ' read ',nparams,' params: ', (params(ip),ip=1,nparams)
      WRITE(6,'(a)') ' '

      IF( kslice(nm) <= 0) kslice(nm) = (nz-2)/2+1
      IF( jslice(nm) <= 0) jslice(nm) = (ny-2)/2+1
      IF( islice(nm) <= 0) islice(nm) = (nx-2)/2+1
    ELSE
      nparams=5
      params(1)='uu'
      params(2)='vv'
      params(3)='ww'
      params(4)='TH'
      params(5)='PR'
!
!-----------------------------------------------------------------------
!
!  Set the printing parameter for each mode
!
!-----------------------------------------------------------------------
!
      iplot(1,nm)=1       ! control for plotting x-y slice
      iplot(2,nm)=1       ! control for plotting x-z slice
      iplot(3,nm)=0       ! control for plotting y-z slice

      kslice(nm) = 3
      jslice(nm) = (ny-2)/2+1
      islice(nm) = 8
    END IF
!
!-----------------------------------------------------------------------
!
!  Transfer the islice info into the ib,ie vectors
!  Likewise for j and k
!
!-----------------------------------------------------------------------
!
    kb(1)=kslice(nm)
    ke(1)=kslice(nm)

    jb(2)=jslice(nm)
    je(2)=jslice(nm)

    ib(3)=islice(nm)
    ie(3)=islice(nm)
!
!-----------------------------------------------------------------------
!
!  Calculate total fields from that for base state and perturbations
!
!-----------------------------------------------------------------------
!
    DO k=1,nz
      DO j=1,ny
        DO i=1,nx
          u(i,j,k)=uprt(i,j,k)+ubar(i,j,k)
          v(i,j,k)=vprt(i,j,k)+vbar(i,j,k)
          w(i,j,k)=wprt(i,j,k)+wbar(i,j,k)
          pt(i,j,k)=ptprt(i,j,k)+ptbar(i,j,k)
          qv(i,j,k)=qvprt(i,j,k)+qvbar(i,j,k)
        END DO
      END DO
    END DO
!
!-----------------------------------------------------------------------
!
!  Loop through three plotting modes
!  producing x-y, x-z and y-z slices of 2-d plotting each time.
!  If iplot(mode)=0, plotting is skipped.
!
!-----------------------------------------------------------------------
!
    DO mode = 1, 3
      WRITE(6,'(a,i3)') 'mode =',mode
      IF( iplot(mode,nm) /= 0 ) THEN
        DO ip=1,nparams
          WRITE(6,'(a,i4,a,a2)')                                        &
              '  ip= ',ip,'  param= ',params(ip)
          IF (params(ip) == 'uu') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'u'
            CALL wrigar(u,                                              &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'vv') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'v'
            CALL wrigar(v,                                              &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'ww') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'w'
            CALL wrigar(w,                                              &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'pt') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'pt'
            CALL wrigar(pt,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'pp') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'pprt '
            CALL wrigar(pprt ,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qv') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qv'
            CALL wrigar(qv,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qc') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qc'
            CALL wrigar(qc,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qr') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qr'
            CALL wrigar(qr,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qi') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qi'
            CALL wrigar(qi,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qs') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qs'
            CALL wrigar(qs,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qh') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qh'
            CALL wrigar(qh,                                             &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)
!
!-----------------------------------------------------------------------
!
!  Perturbation quantities
!
!-----------------------------------------------------------------------
!

          ELSE IF (params(ip) == 'up') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'uprt '
            CALL wrigar(uprt ,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'vp') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'vprt '
            CALL wrigar(vprt ,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'wp') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'wprt '
            CALL wrigar(wprt ,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'tp') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'ptprt'
            CALL wrigar(ptprt,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qp') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qvprt '
            CALL wrigar(qvprt ,                                         &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'ub') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'u base'
            CALL wrigar(ubar,                                           &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'vb') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'v base'
            CALL wrigar(vbar,                                           &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'wb') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'w base'
            CALL wrigar(wbar,                                           &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'tb') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'thbase'
            CALL wrigar(ptbar,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'pb') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'pbar'
            CALL wrigar(pbar,                                           &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)

          ELSE IF (params(ip) == 'qb') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'qvbase'
            CALL wrigar(qvbar,                                          &
                        1,nx,1,ny,1,nz,ib(mode),ie(mode),               &
                        jb(mode),je(mode),kb(mode),ke(mode),            &
                        title,0.,mode)
          ELSE IF (params(ip) == 'st') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'sfc  t'
            CALL wrigar( tsfc,                                          &
                 1,nx,1,ny,1,1,ib(mode),ie(mode),                       &
                 jb(mode),je(mode),1,1,                                 &
                 title,0.,mode)

          ELSE IF (params(ip) == 'LT') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'soil t'
            CALL wrigar( tsoil,                                         &
                 1,nx,1,ny,1,1,ib(mode),ie(mode),                       &
                 jb(mode),je(mode),1,1,                                 &
                 title,0.,mode)

          ELSE IF (params(ip) == 'sm') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'wetsfc'
            CALL wrigar( wetsfc,                                        &
                 1,nx,1,ny,1,1,ib(mode),ie(mode),                       &
                 jb(mode),je(mode),1,1,                                 &
                 title,0.,mode)

          ELSE IF (params(ip) == 'lm') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'wetdp '
            CALL wrigar( wetdp,                                         &
                 1,nx,1,ny,1,1,ib(mode),ie(mode),                       &
                 jb(mode),je(mode),1,1,                                 &
                 title,0.,mode)

          ELSE IF (params(ip) == 'cm') THEN
            WRITE(title,'(a6,1x,a)') runname(1:6),'wetcan'
            CALL wrigar( wetcanp,                                       &
                 1,nx,1,ny,1,1,ib(mode),ie(mode),                       &
                 jb(mode),je(mode),1,1,                                 &
                 title,0.,mode)

          END IF
        END DO
      END IF                                  ! iplot(mode).NE.0
    END DO

  END DO  !  nm

  END IF                                       ! successful read

  GOTO 101
  
  100 CONTINUE
  
  WRITE(6,'(/a,a)') 'Error reading NAMELIST file. The program will abort.'
  
  101 CONTINUE

  STOP
END PROGRAM arpsprt