!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!                                                                   !!
!!                   GNU General Public License                      !!
!!                                                                   !!
!! This file is part of the Flexible Modeling System (FMS).          !!
!!                                                                   !!
!! FMS is free software; you can redistribute it and/or modify       !!
!! it and are expected to follow the terms of the GNU General Public !!
!! License as published by the Free Software Foundation.             !!
!!                                                                   !!
!! FMS is distributed in the hope that it will be useful,            !!
!! but WITHOUT ANY WARRANTY; without even the implied warranty of    !!
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     !!
!! GNU General Public License for more details.                      !!
!!                                                                   !!
!! You should have received a copy of the GNU General Public License !!
!! along with FMS; if not, write to:                                 !!
!!          Free Software Foundation, Inc.                           !!
!!          59 Temple Place, Suite 330                               !!
!!          Boston, MA  02111-1307  USA                              !!
!! or see:                                                           !!
!!          http://www.gnu.org/licenses/gpl.txt                      !!
!!                                                                   !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module bgrid_diagnostics_mod

!-----------------------------------------------------------------------

use types_mod, only : r8
use       bgrid_horiz_mod, only: horiz_grid_type
use        bgrid_vert_mod, only: vert_grid_type, compute_pres_full,  &
                                 compute_pres_half, compute_pres_depth
use       bgrid_masks_mod, only: grid_mask_type
use    bgrid_prog_var_mod, only: prog_var_type
use bgrid_change_grid_mod, only: mass_to_vel

!use      diag_manager_mod, only: diag_axis_init, register_diag_field, &
!                                 register_static_field, send_data
use      time_manager_mod, only: time_type
use            fms_mod, only: file_exist, open_namelist_file,    &
                              error_mesg, NOTE, &
                              stdlog,       &
                              close_file, write_version_number
use      constants_mod, only: GRAV
use  field_manager_mod, only: MODEL_ATMOS
use tracer_manager_mod, only: get_tracer_names, get_number_tracers

implicit none
private

public :: bgrid_diagnostics_init, &
          bgrid_diagnostics,      &
          bgrid_diagnostics_tend

!-----------------------------------------------------------------------
!------------------------- axis names ----------------------------------

character(len=8) :: axiset = 'dynamics'
character(len=8) :: mod_name = 'dynamics'

!-----------------------------------------------------------------------

   integer, parameter :: mxtr = 10
   real(r8),    parameter :: ginv = 1./GRAV

!-----------------------------------------------------------------------

integer :: id_hlonb, id_hlon , id_hlatb, id_hlat , &
           id_vlonb, id_vlon , id_vlatb, id_vlat , &
           id_phalf, id_pfull, id_hlat_wgt, id_vlat_wgt

integer :: id_bk   , id_pk   , id_zsurf, id_res  , id_wspd,          &
           id_ps   , id_ucomp, id_vcomp, id_temp ,                   &
           id_omega, id_div  , id_vor  , id_pgfx , id_pgfy,          &
           id_udt  , id_vdt  , id_tdt
integer, allocatable :: id_tracer(:), id_tracer_tend(:)

integer :: id_ucomp_sq, id_vcomp_sq, id_temp_sq, id_omega_sq, &
           id_ucomp_vcomp, id_omega_temp

!-----------------------------------------------------------------------

 character(len=128) :: version = '$Revision$'
 character(len=128) :: tag = '$Id$'

!-----------------------------------------------------------------------

contains

!#######################################################################

subroutine bgrid_diagnostics_init ( Time, Hgrid, Vgrid, Var, &
                                    fis, res,                &
                                    mass_axes, vel_axes      )

   type(time_type),       intent(in)  :: Time
   type(horiz_grid_type), intent(in)  :: Hgrid
   type (vert_grid_type), intent(in)  :: Vgrid
   type  (prog_var_type), intent(in)  :: Var
   real(r8), intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:)  :: fis, res
   integer, dimension(4), intent(out) :: mass_axes, vel_axes

!-----------------------------------------------------------------------
!           subroutine to set up netcdf info for this run
!-----------------------------------------------------------------------
      real(r8), dimension(Hgrid%Tmp%isg:Hgrid%Tmp%ieg+1) :: hlonb
      real(r8), dimension(Hgrid%Vel%isg:Hgrid%Vel%ieg+1) :: vlonb
      real(r8), dimension(Hgrid%Tmp%jsg:Hgrid%Tmp%jeg+1) :: hlatb
      real(r8), dimension(Hgrid%Vel%jsg:Hgrid%Vel%jeg+1) :: vlatb

      real(r8), dimension(Hgrid%Tmp%isg:Hgrid%Tmp%ieg) :: hlon
      real(r8), dimension(Hgrid%Vel%isg:Hgrid%Vel%ieg) :: vlon
      real(r8), dimension(Hgrid%Tmp%jsg:Hgrid%Tmp%jeg) :: hlat
      real(r8), dimension(Hgrid%Vel%jsg:Hgrid%Vel%jeg) :: vlat

      real(r8), dimension(Hgrid%Tmp%js:Hgrid%Tmp%je) :: hlat_wgt
      real(r8), dimension(Hgrid%Vel%js:Hgrid%Vel%je) :: vlat_wgt

      real(r8), dimension(1,1)              :: psurf
      real(r8), dimension(1,1,Vgrid%nlev)   :: pfull
      real(r8), dimension(1,1,Vgrid%nlev+1) :: phalf

      real(r8)    :: vrange(2), trange(2)
      real(r8)    :: rad2deg
      integer :: i, j, n, unit, io, ierr, ntprog
      integer :: isg, ieg, hsg, heg, vsg, veg
      integer :: is, ie, hs, he, vs, ve
      logical :: used
      character(len=128) :: tname
      character(len=256) :: longname, units

!-----------------------------------------------------------------------
!      ----- write version (to log file) -----

    call write_version_number (version,tag)

!--------------------------- set up axes -------------------------------

      is = Hgrid % Tmp % is;  ie = Hgrid % Tmp % ie
      hs = Hgrid % Tmp % js;  he = Hgrid % Tmp % je
      vs = Hgrid % Vel % js;  ve = Hgrid % Vel % je

      isg = Hgrid % Tmp % isg;  ieg = Hgrid % Tmp % ieg
      hsg = Hgrid % Tmp % jsg;  heg = Hgrid % Tmp % jeg
      vsg = Hgrid % Vel % jsg;  veg = Hgrid % Vel % jeg

      rad2deg = 90./acos(0.0)

      hlonb(isg:ieg+1) = Hgrid % Tmp % blong(isg:ieg+1) * rad2deg
      hlatb(hsg:heg+1) = Hgrid % Tmp % blatg(hsg:heg+1) * rad2deg
      vlonb(isg:ieg+1) = Hgrid % Vel % blong(isg:ieg+1) * rad2deg
      vlatb(vsg:veg+1) = Hgrid % Vel % blatg(vsg:veg+1) * rad2deg

   do i = isg, ieg
      hlon(i) = 0.5*(hlonb(i)+hlonb(i+1))
      vlon(i) = 0.5*(vlonb(i)+vlonb(i+1))
   enddo

   do j = hsg, heg
      hlat(j) = 0.5*(hlatb(j)+hlatb(j+1))
   enddo

   do j = vsg, veg
      vlat(j) = 0.5*(vlatb(j)+vlatb(j+1))
   enddo

!---------- reference profile -----------

    psurf = reshape ( (/ 100000. /), (/ 1, 1 /) )
    call compute_pres_full (Vgrid, psurf, pfull)
    call compute_pres_half (Vgrid, psurf, phalf)
! --- in units of hPa ---
    pfull = pfull*0.01
    phalf = phalf*0.01

!----- mass axes ------

! id_hlonb = diag_axis_init ( 'lonb', hlonb, 'degrees_E', 'x',     &
!                             'longitude edges', set_name='atmos', &
!                             Domain2=Hgrid%Tmp%Domain_nohalo      )

! id_hlon  = diag_axis_init ( 'lon', hlon, 'degrees_E', 'x',       &
!                             'longitude', set_name='atmos',       &
!                             edges=id_hlonb,                      &
!                             Domain2=Hgrid%Tmp%Domain_nohalo      )

! id_hlatb = diag_axis_init ( 'latb', hlatb, 'degrees_N', 'y',     &
!                             'latitude edges', set_name='atmos',  &
!                             Domain2=Hgrid%Tmp%Domain_nohalo      )

! id_hlat  = diag_axis_init ( 'lat', hlat, 'degrees_N', 'y',       &
!                             'latitude', set_name='atmos',        &
!                             edges=id_hlatb,                      &
!                             Domain2=Hgrid%Tmp%Domain_nohalo      )

!----- velocity axes ------

! id_vlonb = diag_axis_init ( 'vlonb', vlonb, 'degrees_E', 'x',    &
!                             'longitude edges', set_name='atmos', &
!                             Domain2=Hgrid%Vel%Domain_nohalo      )

! id_vlon  = diag_axis_init ( 'vlon', vlon, 'degrees_E', 'x',      &
!                             'longitude', set_name='atmos',       &
!                             edges=id_vlonb,                      &
!                             Domain2=Hgrid%Vel%Domain_nohalo      )

! id_vlatb = diag_axis_init ( 'vlatb', vlatb, 'degrees_N', 'y',    &
!                             'latitude edges', set_name='atmos',  &
!                             Domain2=Hgrid%Vel%Domain_nohalo      )

! id_vlat  = diag_axis_init ( 'vlat', vlat, 'degrees_N', 'y',      &
!                             'latitude', set_name='atmos',        &
!                             edges=id_vlatb,                      &
!                             Domain2=Hgrid%Vel%Domain_nohalo      )

!----- vertical axes -----

! id_phalf = diag_axis_init ( 'phalf', phalf(1,1,:), 'hPa', 'z', &
!                             'approx half pressure level',      &
!                             direction=-1, set_name='atmos'     )

! id_pfull = diag_axis_init ( 'pfull', pfull(1,1,:), 'hPa', 'z', &
!                             'approx full pressure level',      &
!                             direction=-1, edges=id_phalf,      &
!                             set_name='atmos'                   )

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!-------- initialize and output variables with no time axis ------------

    mass_axes = (/ id_hlon, id_hlat, id_pfull, id_phalf /)
     vel_axes = (/ id_vlon, id_vlat, id_pfull, id_phalf /)

     vrange = (/ -400., +400. /)
     trange = (/  100.,  400. /)

!-----------------------------------------------------------------------
!---- register static fields -------

!  id_bk    = register_static_field ( mod_name, 'bk', (/id_phalf/), &
!                        'vertical coordinate sigma value', 'none' )

!  id_pk    = register_static_field ( mod_name, 'pk', (/id_phalf/), &
!   'vertical coordinate reference pressure value (ak*pref)', 'pascals' )

!  id_zsurf = register_static_field ( mod_name, 'zsurf', mass_axes(1:2),&
!                                       'surface height', 'm' )

!  id_res   = register_static_field ( mod_name, 'res', mass_axes(1:2), &
!                     'reciprocal of sigma/eta at the surface', 'none' )

! these changes cannot be implemented until changes to diag_manager
!
! id_hlat_wgt = register_static_field ( mod_name, 'lat_wgt',  &
!                 (/id_hlat/), 'latitude weight for mass grid', 'none' )
!
! id_vlat_wgt = register_static_field ( mod_name, 'vlat_wgt',  &
!             (/id_vlat/), 'latitude weight for momentum grid', 'none' )

!      if ( id_bk > 0 ) &
!      used = send_data ( id_bk, Vgrid%eta, Time )

!      if ( id_pk > 0 ) &
!      used = send_data ( id_pk, Vgrid%peta, Time )

!      if ( id_zsurf > 0 ) &
!      used = send_data ( id_zsurf, fis(is:ie,hs:he)*ginv, Time )

!      if ( id_res > 0 ) &
!      used = send_data ( id_res, res(is:ie,hs:he), Time )

!     if ( id_hlat_wgt > 0 ) then
!        hlat_wgt = sin(Hgrid%Tmp%blatg(hs+1:he+1))-sin(Hgrid%Tmp%blatg(hs:he))
!        used = send_data ( id_hlat_wgt, hlat_wgt, Time )
!     endif
!
!     if ( id_vlat_wgt > 0 ) then
!        vlat_wgt = sin(Hgrid%Vel%blatg(vs+1:ve+1))-sin(Hgrid%Vel%blatg(vs:ve))
!        used = send_data ( id_vlat_wgt, vlat_wgt, Time )
!     endif

!---- register non-static fields -------

!   id_ps   = register_diag_field ( mod_name, 'ps', mass_axes(1:2), &
!                               Time, 'surface pressure', 'pascals' )

!   id_ucomp = register_diag_field ( mod_name, 'ucomp', vel_axes(1:3), &
!                           Time, 'zonal wind component', 'm/sec',     &
!                           missing_value=vrange(1), range=vrange      )

!   id_vcomp = register_diag_field ( mod_name, 'vcomp', vel_axes(1:3), &
!                        Time, 'meridional wind component', 'm/sec',   &
!                        missing_value=vrange(1), range=vrange         )

!   id_temp = register_diag_field ( mod_name, 'temp', mass_axes(1:3), &
!                             Time, 'temperature', 'deg_k',           &
!                             missing_value=trange(1), range=trange   )

 ! diagnostics for all tracers
   allocate (id_tracer(Var%ntrace))
   write(stdlog(),100) trim(mod_name)
   do n = 1, Var%ntrace
     call get_tracer_names ( MODEL_ATMOS, n, tname, longname, units )
     write(stdlog(),110) trim(tname),trim(longname),trim(units)
!     id_tracer(n) = register_diag_field ( mod_name, trim(tname),  &
!                            mass_axes(1:3), Time, trim(longname), &
!                            trim(units), missing_value=-999.      )
   enddo
100 format ('Diagnostics for the following tracer fields are available for module name = ',a)
110 format (3x,a,' (',a,'; ',a,')')

!   id_omega = register_diag_field ( mod_name, 'omega', mass_axes(1:3),&
!                                 Time, 'omega vertical velocity',     &
!                                 'pascals/sec',                       &
!                                 missing_value=-999.                  )

!-------- register second-moment quantities -------

!   id_ucomp_sq = register_diag_field ( mod_name, 'ucomp_sq', vel_axes(1:3), &
!                           Time, 'zonal wind component squared', 'm2/s2',   &
!                           missing_value=-1., range=(/0.,vrange(2)**2/)   )

!   id_vcomp_sq = register_diag_field ( mod_name, 'vcomp_sq', vel_axes(1:3), &
!                      Time, 'meridional wind component squared', 'm2/s2',   &
!                       missing_value=-1., range=(/0.,vrange(2)**2/)   )

!   id_temp_sq = register_diag_field ( mod_name, 'temp_sq', mass_axes(1:3), &
!                             Time, 'temperature squared', 'deg_K**2',      &
!                             missing_value=-1., range=(/0.,trange(2)**2/)  )

!   id_omega_sq = register_diag_field ( mod_name, 'omega_sq', mass_axes(1:3),&
!                                 Time, 'omega vertical velocity squared',   &
!                                 'Pa**2/s**2', missing_value=-999.          )

!   id_ucomp_vcomp = register_diag_field ( mod_name, 'ucomp_vcomp', vel_axes(1:3),&
!                       Time, 'zonal times meridional wind components', 'm2/s2',  &
!                       missing_value=-1. )

!   id_omega_temp = register_diag_field ( mod_name, 'omega_temp', mass_axes(1:3),&
!                               Time, 'omega vertical velocity time temperature',&
!                                 'Pascals*deg_K/sec', missing_value=-999.       )

!-------- wind speed, divergence, vorticity ----------------------------

!   id_wspd = register_diag_field ( mod_name, 'wspd', vel_axes(1:3),   &
!                       Time, 'wind speed', 'm/s', missing_value=-999.,&
!                       range=(/0.,vrange(2)/) )

!   id_div  = register_diag_field ( mod_name, 'div', mass_axes(1:3),   &
!                       Time, 'divergence', '1/s', missing_value=-999. )

!   id_vor  = register_diag_field ( mod_name, 'vor', mass_axes(1:3),   &
!               Time, 'relative vorticity', '1/s', missing_value=-999. )

!--------------- pressure gradient components --------------------------

!  id_pgfx = register_diag_field ( mod_name, 'pgfx', vel_axes(1:3), &
!                            Time, 'zonal pressure gradient force', &
!                            'm/s2', missing_value=-999.            )

!  id_pgfy = register_diag_field ( mod_name, 'pgfy', vel_axes(1:3), &
!                       Time, 'meridional pressure gradient force', &
!                       'm/s2', missing_value=-999.                 )

!-----------------------------------------------------------------------
!         -------- tendencies ---------

!   id_udt = register_diag_field ( mod_name, 'udt_dyn', vel_axes(1:3),  &
!                            Time, 'zonal wind tendency for dynamics', &
!                            'm/s2', missing_value=-999. )

!   id_vdt = register_diag_field ( mod_name, 'vdt_dyn', vel_axes(1:3),  &
!                        Time, 'meridional wind tendency for dynamics', &
!                        'm/s2', missing_value=-999. )

!   id_tdt = register_diag_field ( mod_name, 'tdt_dyn', mass_axes(1:3), &
!                            Time, 'temperature tendency for dynamics', &
!                            'deg_k/sec', missing_value=-999. )

 ! need to do this for just prognostic variables
   call get_number_tracers ( MODEL_ATMOS, num_prog=ntprog )
   allocate (id_tracer_tend(ntprog))
   do n = 1, ntprog
     call get_tracer_names ( MODEL_ATMOS, n, tname, longname, units )
     tname    = trim(tname)   //'_dt_dyn'
     longname = trim(longname)//' tendency for dynamics'
     units    = trim(units)   //'/s'
     if (units == 'none') units = '1/sec'
     write(stdlog(),110) trim(tname),trim(longname),trim(units)
!     id_tracer_tend(n) = register_diag_field ( mod_name, trim(tname),  &
!                                 mass_axes(1:3), Time, trim(longname), &
!                                 trim(units), missing_value=-999.      )
   enddo

!-----------------------------------------------------------------------

   end subroutine bgrid_diagnostics_init

!#######################################################################

 subroutine bgrid_diagnostics ( Hgrid, Vgrid, Var, Masks, Time, omega )

!-----------------------------------------------------------------------
type(horiz_grid_type), intent(in) :: Hgrid
type (vert_grid_type), intent(in) :: Vgrid
type (prog_var_type),  intent(in) :: Var
type(grid_mask_type),  intent(in) :: Masks
type(time_type),       intent(in) :: Time
   real(r8), intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: omega

!  real(r8), intent(in), dimension(Hgrid%ilb:,Hgrid%jlb:,:), optional ::&
!                                               div, pgfx, pgfy

   real(r8), dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub, &
                   Vgrid%nlev) :: wspd, vor, div, adp, udp, vdp
!-----------------------------------------------------------------------
   integer :: is, ie, hs, he, vs, ve, n, k
   logical :: used
!-----------------------------------------------------------------------

      is = Hgrid % Tmp % is;  ie = Hgrid % Tmp % ie
      hs = Hgrid % Tmp % js;  he = Hgrid % Tmp % je
      vs = Hgrid % Vel % js;  ve = Hgrid % Vel % je

!-----------------------------------------------------------------------
!---------------- surface fields ---------------------------------------

!      if ( id_ps > 0 ) &
!      used = send_data ( id_ps , Var%ps(is:ie,hs:he), Time )

!---------------- 3d momentum fields (u & v) ---------------------------

!      if ( id_ucomp > 0 ) &
!      used = send_data ( id_ucomp, Var%u(is:ie,vs:ve,:), Time,    &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_vcomp > 0 ) &
!      used = send_data ( id_vcomp, Var%v(is:ie,vs:ve,:), Time,    &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_temp > 0 ) &
!      used = send_data ( id_temp, Var%t(is:ie,hs:he,:), Time,     &
!                         mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!      do n = 1, Var%ntrace
!        if ( id_tracer(n) > 0 ) &
!        used = send_data ( id_tracer(n), Var%r(is:ie,hs:he,:,n), Time, &
!                           mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5    )
!      enddo

!      if ( id_omega > 0 ) &
!      used = send_data ( id_omega, omega(is:ie,hs:he,:), Time,    &
!                         mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!--------- second moment quantities ----------

!      if ( id_ucomp_sq > 0 ) &
!      used = send_data ( id_ucomp_sq, Var%u(is:ie,vs:ve,:)**2, Time, &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_vcomp_sq > 0 ) &
!      used = send_data ( id_vcomp_sq, Var%v(is:ie,vs:ve,:)**2, Time, &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_temp_sq > 0 ) &
!      used = send_data ( id_temp_sq, Var%t(is:ie,hs:he,:)**2, Time, &
!                         mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!      if ( id_omega_sq > 0 ) &
!      used = send_data ( id_omega_sq, omega(is:ie,hs:he,:)**2, Time, &
!                         mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!      if ( id_ucomp_vcomp > 0 ) used = send_data ( id_ucomp_vcomp, &
!                  Var%u(is:ie,vs:ve,:)*Var%v(is:ie,vs:ve,:), Time, &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_omega_temp > 0 ) used = send_data ( id_omega_temp, &
!                omega(is:ie,hs:he,:)*Var%t(is:ie,hs:he,:), Time, &
!                        mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!------------ wind speed, divergence, vorticity ------------------------

      if ( id_wspd > 0 ) then
          wspd(is:ie,vs:ve,:) = sqrt &
                      ( Var%u(is:ie,vs:ve,:)*Var%u(is:ie,vs:ve,:) + &
                        Var%v(is:ie,vs:ve,:)*Var%v(is:ie,vs:ve,:) )
!          used = send_data ( id_wspd, wspd(is:ie,vs:ve,:), Time,      &
!                             mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )
      endif

      if ( id_vor > 0 .or. id_div > 0 ) then
!     --- precompute quantities common to both vor and div ---
         call compute_pres_depth (Vgrid, Var%pssl, adp)
         call mass_to_vel (Hgrid, adp, udp)
         vdp = Var%v * udp
         udp = Var%u * udp
         do k=1,size(adp,3)
           adp(:,:,k) = 2.0 * Hgrid%Tmp%area * adp(:,:,k)
         enddo
         if ( id_vor > 0 ) then
             call compute_vorticity (Hgrid, adp, udp, vdp, vor )
!             used = send_data ( id_vor, vor(is:ie,hs:he,:), Time,      &
!                              mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )
         endif
         if ( id_div > 0 ) then
             call compute_divergence (Hgrid, adp, udp, vdp, div )
!             used = send_data ( id_div, div(is:ie,hs:he,:), Time,      &
!                              mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )
         endif
      endif

!--------------- optional arguments ------------------------------------
!--------------- pressure gradient components --------------------------

!     if ( id_div > 0 .and. present(div) )  &
!     used = send_data ( id_div, div(is:ie,hs:he,:), Time,        &
!                        mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!     if ( id_pgfx > 0 .and. present(pgfx) )  &
!     used = send_data ( id_pgfx, pgfx(is:ie,vs:ve,:), Time,      &
!                        mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!     if ( id_pgfy > 0 .and. present(pgfy) )  &
!     used = send_data ( id_pgfy, pgfy(is:ie,vs:ve,:), Time,      &
!                        mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!-----------------------------------------------------------------------

 end subroutine bgrid_diagnostics

!#######################################################################

 subroutine bgrid_diagnostics_tend ( Hgrid, Var_dt, Masks, Time )

!-----------------------------------------------------------------------
type(horiz_grid_type), intent(in) :: Hgrid
type (prog_var_type),  intent(in) :: Var_dt
type(grid_mask_type),  intent(in) :: Masks
type(time_type),       intent(in) :: Time
!-----------------------------------------------------------------------
   integer :: is, ie, hs, he, vs, ve, n
   logical :: used
!-----------------------------------------------------------------------

      is = Hgrid % Tmp % is;  ie = Hgrid % Tmp % ie
      hs = Hgrid % Tmp % js;  he = Hgrid % Tmp % je
      vs = Hgrid % Vel % js;  ve = Hgrid % Vel % je

!-----------------------------------------------------------------------
!---------------- 3d prognostic fields ---------------------------

!      if ( id_udt > 0 ) &
!      used = send_data ( id_udt, Var_dt%u(is:ie,vs:ve,:), Time,    &
!                          mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_vdt > 0 ) &
!      used = send_data ( id_vdt, Var_dt%v(is:ie,vs:ve,:), Time,   &
!                         mask=Masks%Vel%mask(is:ie,vs:ve,:) > 0.5 )

!      if ( id_tdt > 0 ) &
!      used = send_data ( id_tdt, Var_dt%t(is:ie,hs:he,:), Time,   &
!                         mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )

!      do n = 1, Var_dt%ntrace
!       if ( id_tracer_tend(n) > 0 ) &
!       used = send_data ( id_tracer_tend(n), Var_dt%r(is:ie,hs:he,:,n),  &
!                          Time, mask=Masks%Tmp%mask(is:ie,hs:he,:) > 0.5 )
!      enddo

!-----------------------------------------------------------------------

 end subroutine bgrid_diagnostics_tend

!#######################################################################

 subroutine compute_vorticity ( Hgrid, adp, udp, vdp, vor )

!-----------------------------------------------------------------------
type(horiz_grid_type), intent(in) :: Hgrid
real(r8), intent(in),  dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: adp, udp, vdp
real(r8), intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: vor

real(r8),dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) :: &
                          vdy,udx,few,fns
integer :: i,j,k,is,ie,js,je

   is = Hgrid % Tmp % is;  ie = Hgrid % Tmp % ie
   js = Hgrid % Tmp % js;  je = Hgrid % Tmp % je

   do k = 1, size(adp,3)
      vdy(:,:) = vdp(:,:,k)*Hgrid%Vel%dy
      udx(:,:) = udp(:,:,k)*Hgrid%Vel%dx(:,:)

      do j = js,   je
      do i = is-1, ie
         fns(i,j) = vdy(i,j-1)+vdy(i,j)
      enddo
      enddo
      do j = js-1, je
      do i = is,   ie
         few(i,j) = udx(i-1,j)+udx(i,j)
      enddo
      enddo

!  ------ vorticity ------
      do j = js, je
      do i = is, ie
         vor(i,j,k)=((fns(i,j)-fns(i-1,j))-(few(i,j)-few(i,j-1))) &
                    /adp(i,j,k)
      enddo
      enddo
   enddo

 end subroutine compute_vorticity

!#######################################################################

 subroutine compute_divergence ( Hgrid, adp, udp, vdp, div )

!-----------------------------------------------------------------------
type(horiz_grid_type), intent(in) :: Hgrid
real(r8), intent(in),  dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: adp, udp, vdp
real(r8), intent(out), dimension(Hgrid%ilb:,Hgrid%jlb:,:) :: div

real(r8),dimension(Hgrid%ilb:Hgrid%iub,Hgrid%jlb:Hgrid%jub) ::  &
                          udy,vdx,few,fns
integer :: i,j,k,is,ie,js,je

   is = Hgrid % Tmp % is;  ie = Hgrid % Tmp % ie
   js = Hgrid % Tmp % js;  je = Hgrid % Tmp % je

   do k = 1, size(adp,3)
      udy(:,:) = udp(:,:,k)*Hgrid%Vel%dy
      vdx(:,:) = vdp(:,:,k)*Hgrid%Vel%dx(:,:)

      do j = js,   je
      do i = is-1, ie
         few(i,j) = udy(i,j-1)+udy(i,j)
      enddo
      enddo
      do j = js-1, je
      do i = is,   ie
         fns(i,j) = vdx(i-1,j)+vdx(i,j)
      enddo
      enddo

!  ------ divergence ------
      do j = js, je
      do i = is, ie
         div(i,j,k)=((few(i,j)+fns(i,j))-(few(i-1,j)+fns(i,j-1))) &
                    /adp(i,j,k)
      enddo
      enddo
   enddo

 end subroutine compute_divergence

!#######################################################################

end module bgrid_diagnostics_mod


      subroutine sumv

!!    ~ ~ ~ PURPOSE ~ ~ ~
!!    this subroutine performs summary calculations for HRU

!!    ~ ~ ~ INCOMING VARIABLES ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    auton       |kg N/ha       |amount of nitrogen applied in auto-fert
!!                               |application
!!    autop       |kg P/ha       |amount of phosphorus applied in auto-fert
!!                               |application
!!    bactrolp    |# colonies/ha |less persistent bacteria transported to main
!!                               |channel with surface runoff
!!    bactrop     |# colonies/ha |persistent bacteria transported to main
!!                               |channel with surface runoff
!!    bactsedlp   |# colonies/ha |less persistent bacteria transported with
!!                               |sediment in surface runoff
!!    bactsedp    |# colonies/ha |persistent bacteria transported with
!!                               |sediment in surface runoff
!!    cfertn      |kg N/ha       |amount of nitrogen added to soil in continuous
!!                               |fertilizer operation on day
!!    cfertp      |kg P/ha       |amount of phosphorus added to soil in continuous
!!                               |fertilizer operation on day
!!    cnday(:)    |none          |curve number for current day, HRU and at
!!                               |current soil moisture
!!    curyr       |none          |current year of simulation
!!    deepirr(:)  |mm H2O        |amount of water removed from deep aquifer
!!                               |for irrigation
!!    ep_day      |mm H2O        |actual amount of transpiration that occurs on
!!                               |day in HRU
!!    es_day      |mm H2O        |actual amount of evaporation (from soil) that
!!                               |occurs on day in HRU
!!    etday       |mm H2O        |actual amount of evapotranspiration that
!!                               |occurs on day in HRU
!!    fertn       |kg N/ha       |total amount of nitrogen added to soil in HRU
!!                               |on day in fertilizer application
!!    fertp       |kg P/ha       |total amount of phosphorus added to soil in
!!                               |HRU on day in fertilizer application
!!    fixn        |kg N/ha       |amount of nitrogen added to plant biomass via
!!                               |fixation on the day in HRU
!!    grazn       |kg N/ha       |amount of nitrogen added to soil in grazing
!!                               |on the day in HRU
!!    grazp       |kg P/ha       |amount of phosphorus added to soil in grazing
!!                               |on the day in HRU
!!    gw_q(:)     |mm H2O        |groundwater contribution to streamflow from
!!                               |HRU on current day
!!    gwseep      |mm H2O        |amount of water recharging deep aquifer on
!!                               |current day
!!    hmntl       |kg N/ha       |amount of nitrogen moving from active
!!                               |organic to nitrate pool in soil profile
!!                               |on current day in HRU
!!    hmptl       |kg P/ha       |amount of phosphorus moving from the
!!                               |organic to labile pool in soil profile
!!                               |on current day in HRU
!!    hru_dafr(:) |none          |fraction of watershed area in HRU
!!    hru_ha(:)   |ha            |area of HRU in hectares
!!    ihru        |none          |HRU number
!!    lat_pst(:)  |kg pst/ha     |amount of pesticide in lateral flow in HRU
!!                               |for the day
!!    latno3(:)   |kg N/ha       |amount of NO3-N in lateral flow in HRU for the
!!                               |day
!!    latq(:)     |mm H2O        |amount of water in lateral flow in HRU for the
!!                               |day
!!    minpgw(:)   |kg P/ha       |soluble P loading to reach in groundwater
!!    no3gw(:)    |kg N/ha       |nitrate loading to reach in groundwater
!!    no3pcp      |kg N/ha       |nitrate added to the soil in rainfall
!!    nplnt(:)    |kg N/ha       |plant uptake of nitrogen in HRU for the day
!!    npmx        |none          |number of different pesticides used in
!!                               |the simulation
!!    nyskip      |none          |number of years to skip output summarization
!!                               |and printing
!!    percn(:)    |kg N/ha       |NO3-N leached from soil profile during the day
!!    pet_day     |mm H2O        |potential evapotranspiration for day in HRU
!!    pndev       |m^3 H2O       |evaporation from pond on day
!!    pndflwi     |m^3 H2O       |volume of water flowing into pond on day
!!    pndflwo     |m^3 H2O       |volume of water flowing out of pond on day
!!    pndpcp      |m^3 H2O       |precipitation on pond during day
!!    pndsedc     |metric tons   |net change in sediment in pond during day
!!    pndsedin    |metric tons   |sediment entering pond during day
!!    pndsedo     |metric tons   |sediment leaving pond during day
!!    pndsep      |m^3 H2O       |seepage from pond on day
!!    potevmm     |mm H2O        |volume of water evaporated from pothole
!!                               |expressed as depth over HRU
!!    potflwi(:)  |m^3 H2O       |water entering pothole on day
!!    potflwo     |mm H2O        |discharge from pothole expressed as depth
!!                               |over HRU
!!    potpcpmm    |mm H2O        |precipitation falling on pothole water body
!!                               |expressed as depth over HRU
!!    potsedi(:)  |metric tons   |sediment entering pothole on day
!!    potsedo     |metric tons   |sediment leaving pothole on day
!!    potsepmm    |mm H2O        |seepage from pothole expressed as depth over
!!                               |HRU
!!    pplnt(:)    |kg P/ha       |plant uptake of phosphorus in HRU for the day
!!    pst_sed(:,:)|kg/ha         |pesticide loading from HRU sorbed onto
!!                               |sediment
!!    pst_surq(:,:)|kg/ha        |amount of pesticide type lost in surface
!!                               |runoff on current day in HRU
!!    pstsol(:)   |kg/ha         |amount of pesticide type leached from soil
!!                               |profile on current day
!!    qday        |mm H2O        |surface runoff loading to main channel for
!!                               |day in HRU
!!    qdr(:)      |mm H2O        |total amount of water entering main channel
!!                               |for day from HRU
!!    qtile       |mm H2O        |drainage tile flow for day in HRU
!!    rchrg(:)    |mm H2O        |amount of water recharging both aquifers on
!!                               |current day in HRU
!!    revapday    |mm H2O        |amount of water moving from the shallow
!!                               |aquifer into the soil profile or being taken
!!                               |up by plant roots in the shallow aquifer
!!    rmn2tl      |kg N/ha       |amount of nitrogen moving from the fresh
!!                               |organic (residue) to the nitrate(80%) and
!!                               |active organic(20%) pools in soil profile
!!                               |on current day in HRU
!!    rmp1tl      |kg P/ha       |amount of phosphorus moving from the labile
!!                               |mineral pool to the active mineral pool in
!!                               |the soil profile on the current day in the
!!                               |HRU
!!    rmptl       |kg P/ha       |amount of phosphorus moving from the
!!                               |fresh organic (residue) to the labile(80%)
!!                               |and organic(20%) pools in soil profile
!!                               |on current day in HRU
!!    roctl       |kg P/ha       |amount of phosphorus moving from the active
!!                               |mineral pool to the stable mineral pool
!!                               |in the soil profile on the current day in
!!                               |the HRU
!!    rwntl       |kg N/ha       |amount of nitrogen moving from active
!!                               |organic to stable organic pool in soil
!!                               |profile on current day in HRU
!!    sedminpa(:) |kg P/ha       |amount of active mineral phosphorus sorbed to
!!                               |sediment in surface runoff in HRU for day
!!    sedminps(:) |kg P/ha       |amount of stable mineral phosphorus sorbed to
!!                               |sediment in surface runoff in HRU for day
!!    sedorgn(:)  |kg N/ha       |amount of organic nitrogen in surface runoff
!!                               |in HRU for the day
!!    sedorgp(:)  |kg P/ha       |amount of organic phosphorus in surface runoff
!!                               |in HRU for the day
!!    sedyld(:)   |metric tons   |daily soil loss caused by water erosion
!!    sepbtm(:)   |mm H2O        |seepage leaving the bottom of the soil profile
!!                               |on day in HRU
!!    shallirr(:) |mm H2O        |amount of water removed from shallow aquifer
!!                               |for irrigation
!!    snoev       |mm H2O        |amount of water in snow lost through
!!                               |sublimation on current day in HRU
!!    snofall     |mm H2O        |amount of precipitation falling as freezing
!!                               |rain/snow on day in HRU
!!    snomlt      |mm H2O        |amount of water in snow melt for the day in
!!                               |HRU
!!    sol_cnsw(:) |mm H2O        |soil water content used to calculate daily
!!                               |CN value (initial soil wter content for day)
!!    sol_sw(:)   |mm H2O        |amount of water stored in the soil profile
!!                               |on any given day
!!    sol_tmp(2,:)|deg C         |daily average temperature of second soil layer
!!    strsn(:)    |none          |fraction of potential plant growth achieved on
!!                               |the day where the reduction is caused by
!!                               |nitrogen stress
!!    strsp(:)    |none          |fraction of potential plant growth achieved on
!!                               |the day where the reduction is caused by
!!                               |phosphorus stress
!!    strstmp(:)  |none          |fraction of potential plant growth achieved on
!!                               |the day in HRU where the reduction is caused
!!                               |by temperature stress
!!    strsw(:)    |none          |fraction of potential plant growth achieved on
!!                               |the day where the reduction is caused by
!!                               |water stress
!!    subp(:)     |mm H2O        |precipitation for the day in HRU
!!    surfq(:)    |mm H2O        |surface runoff generated on day in HRU
!!    surqno3(:)  |kg N/ha       |amount of NO3-N in surface runoff in HRU for
!!                               |the day
!!    surqsolp(:) |kg P/ha       |amount of soluble phosphorus in surface runoff
!!                               |in HRU for the day
!!    tloss       |mm H2O        |amount of water removed from surface runoff
!!                               |via transmission losses on day in HRU
!!    tmn(:)      |deg C         |minimum temperature for the day in HRU
!!    tmx(:)      |deg C         |maximum temperature for the day in HRU
!!    usle        |metric tons   |daily soil loss predicted with USLE equation
!!    wdntl       |kg N/ha       |amount of nitrogen lost from nitrate pool
!!                               |by denitrification in soil profile on
!!                               |current day in HRU
!!    wetev       |m^3 H2O       |evaporation from wetland for day
!!    wetflwi     |m^3 H2O       |volume of water flowing in wetland on day
!!    wetflwo     |m^3 H2O       |volume of water flowing out wetland on day
!!    wetpcp      |m^3 H2O       |precipitation on wetland for day
!!    wetsedc     |metric tons   |net change in sediment in wetland during day
!!    wetsedi     |metric tons   |sediment loading to wetland for day
!!    wetsedo     |metric tons   |sediment loading from wetland for day
!!    wetsep      |m^3 H2O       |seepage from wetland bottom for day
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ OUTGOING VARIABLES ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    hrupstd(:,1,:)|mg pst      |amount of pesticide type in surface runoff
!!                               |contribution to stream from HRU on day
!!                               |(in solution)
!!    hrupstd(:,2,:)|mg pst      |amount of pesticide type in surface runoff
!!                               |contribution to stream from HRU on day
!!                               |(sorbed to sediment)
!!    hrupstd(:,3,:)|mg pst/ha   |total pesticide loading to stream in surface
!!                               |runoff from HRU
!!    hrupstd(:,4,:)|mg pst      |amount of pesticide type in lateral flow
!!                               |contribution to stream from HRU on day
!!                               |(in solution)
!!    hrumono(1,:)|mm H2O        |precipitation in HRU during month
!!    hrumono(2,:)|mm H2O        |amount of precipitation falling as freezing
!!                               |rain/snow in HRU during month
!!    hrumono(3,:)|mm H2O        |amount of snow melt in HRU during month
!!    hrumono(4,:)|mm H2O        |amount of surface runoff to main channel
!!                               |from HRU during month (ignores impact of
!!                               |transmission losses)
!!    hrumono(5,:)|mm H2O        |amount of lateral flow contribution to main
!!                               |channel from HRU during month
!!    hrumono(6,:)|mm H2O        |amount of groundwater flow contribution to
!!                               |main channel from HRU during month
!!    hrumono(7,:)|mm H2O        |amount of water moving from shallow aquifer
!!                               |to plants or soil profile in HRU during month
!!    hrumono(8,:)|mm H2O        |amount of water recharging deep aquifer in
!!                               |HRU during month
!!    hrumono(9,:)|mm H2O        |total amount of water entering both aquifers
!!                               |from HRU during month
!!    hrumono(10,:)|mm H2O        |water yield (total amount of water entering
!!                               |main channel) from HRU during month
!!    hrumono(11,:)|mm H2O        |amount of water percolating out of the soil
!!                               |profile and into the vadose zone in HRU
!!                               |during month
!!    hrumono(12,:)|mm H2O        |actual evapotranspiration in HRU during month
!!    hrumono(13,:)|mm H2O        |amount of transmission losses from tributary
!!                               |channels in HRU for month
!!    hrumono(14,:)|metric tons/ha|sediment yield from HRU for month
!!    hrumono(15,:)|mm H2O        |actual amount of transpiration that occurs
!!                               |during month in HRU
!!    hrumono(16,:)|mm H2O        |actual amount of evaporation (from soil) that
!!                               |occurs during month in HRU
!!    hrumono(17,:)|kg N/ha       |amount of nitrogen applied in continuous
!!                               |fertilizer operation during month in HRU
!!    hrumono(18,:)|kg P/ha       |amount of phosphorus applied in continuous
!!                               |fertilizer operation during month in HRU
!!    hrumono(19,:)|mm H2O        |amount of surface runoff generated during month
!!                               |in HRU
!!    hrumono(20,:)|none          |CN values during month in HRU
!!    hrumono(21,:)|mm H2O        |sum of daily soil water values used to calculate
!!                               |the curve number
!!    hrumono(23,:)|mm H2O        |amount of water removed from shallow aquifer
!!                               |in HRU for irrigation during month
!!    hrumono(24,:)|mm H2O        |amount of water removed from deep aquifer
!!                               |in HRU for irrigation during month
!!    hrumono(25,:)|mm H2O        |potential evapotranspiration in HRU during
!!                               |month
!!    hrumono(26,:)|kg N/ha       |monthly amount of N (organic & mineral)
!!                               |applied in HRU during grazing
!!    hrumono(27,:)|kg P/ha       |monthly amount of P (organic & mineral)
!!                               |applied in HRU during grazing
!!    hrumono(28,:)|kg N/ha       |monthly amount of N (organic & mineral)
!!                               |auto-applied in HRU
!!    hrumono(29,:)|kg P/ha       |monthly amount of P (organic & mineral)
!!                               |auto-applied in HRU
!!    hrumono(30,:)|deg C         |sum of daily soil temperature values
!!    hrumono(31,:)|stress days   |water stress days in HRU during month
!!    hrumono(32,:)|stress days   |temperature stress days in HRU during month
!!    hrumono(33,:)|stress days   |nitrogen stress days in HRU during month
!!    hrumono(34,:)|stress days   |phosphorus stress days in HRU during month
!!    hrumono(35,:)|kg N/ha       |organic nitrogen in surface runoff in HRU
!!                               |during month
!!    hrumono(36,:)|kg P/ha       |organic phosphorus in surface runoff in HRU
!!                               |during month
!!    hrumono(37,:)|kg N/ha       |nitrate in surface runoff in HRU during month
!!    hrumono(38,:)|kg N/ha       |nitrate in lateral flow in HRU during month
!!    hrumono(39,:)|kg P/ha       |soluble phosphorus in surface runoff in HRU
!!                               |during month
!!    hrumono(40,:)|kg N/ha       |amount of nitrogen removed from soil by plant
!!                               |uptake in HRU during month
!!    hrumono(41,:)|kg N/ha       |nitrate percolating past bottom of soil
!!                               |profile in HRU during month
!!    hrumono(42,:)|kg P/ha       |amount of phosphorus removed from soil by
!!                               |plant uptake in HRU during month
!!    hrumono(43,:)|kg P/ha       |amount of phosphorus moving from labile
!!                               |mineral to active mineral pool in HRU during
!!                               |month
!!    hrumono(44,:)|kg P/ha       |amount of phosphorus moving from active
!!                               |mineral to stable mineral pool in HRU during
!!                               |month
!!    hrumono(45,:)|kg N/ha       |amount of nitrogen applied to HRU in
!!                               |fertilizer and grazing operations during month
!!    hrumono(46,:)|kg P/ha       |amount of phosphorus applied to HRU in
!!                               |fertilizer and grazing operations during month
!!    hrumono(47,:)|kg N/ha       |amount of nitrogen added to soil by fixation
!!                               |in HRU during month
!!    hrumono(48,:)|kg N/ha       |amount of nitrogen lost by denitrification
!!                               |in HRU during month
!!    hrumono(49,:)|kg N/ha       |amount of nitrogen moving from active organic
!!                               |to nitrate pool in HRU during month
!!    hrumono(50,:)|kg N/ha       |amount of nitrogen moving from active organic
!!                               |to stable organic pool in HRU during month
!!    hrumono(51,:)|kg P/ha       |amount of phosphorus moving from organic to
!!                               |labile mineral pool in HRU during month
!!    hrumono(52,:)|kg N/ha       |amount of nitrogen moving from fresh organic
!!                               |to nitrate and active organic pools in HRU
!!                               |during month
!!    hrumono(53,:)|kg P/ha       |amount of phosphorus moving from fresh
!!                               |organic to the labile mineral and organic
!!                               |pools in HRU during month
!!    hrumono(54,:)|kg N/ha       |amount of nitrogen added to soil in rain
!!    hrumono(61,:)|metric tons/ha|daily soil loss predicted with USLE equation
!!    hrumono(62,:)|mm H2O        |drainage tile flow contribution to main
!!                               |channel from HRU in month
!!    hrumono(63,:)|# bacteria/ha |persistent bacteria transported to main
!!                               |channel from HRU during month
!!    hrumono(64,:)|# bacteria/ha |less persistent bacteria transported to main
!!                               |channel from HRU during month
!!    hrumono(65,:)|kg N/ha       |nitrate loading from groundwater in HRU to
!!                               |main channel during month
!!    hrumono(66,:)|kg P/ha       |soluble P loading from groundwater in HRU to
!!                               |main channel during month
!!    hrumono(67,:)|kg P/ha       |loading of mineral P attached to sediment
!!                               |in HRU to main channel during month
!!    wpstdayo(:,1) |mg pst/ha   |amount of pesticide type in surface runoff
!!                               |contribution to stream in watershed on day
!!                               |(in solution)
!!    wpstdayo(:,2) |mg pst/ha   |amount of pesticide type in surface runoff
!!                               |contribution to stream in watershed on day
!!                               |(sorbed to sediment)
!!    wpstdayo(:,3) |kg pst/ha   |amount of pesticide type leached from soil
!!                               |profile in watershed on day
!!    wpstdayo(:,4) |kg pst/ha   |amount of pesticide type in lateral flow
!!                               |contribution to stream in watershed on day
!!    wshddayo(1) |mm H2O        |average amount of precipitation in watershed
!!                               |for the day
!!    wshddayo(3) |mm H2O        |surface runoff in watershed for day
!!    wshddayo(4) |mm H2O        |lateral flow contribution to streamflow in
!!                               |watershed for day
!!    wshddayo(5) |mm H2O        |water percolation past bottom of soil profile
!!                               |in watershed for day
!!    wshddayo(6) |mm H2O        |water yield to streamflow from HRUs in
!!                               |watershed for day
!!    wshddayo(7) |mm H2O        |actual evapotranspiration in watershed
!!                               |for day
!!    wshddayo(8) |deg C         |average maximum temperature in watershed for
!!                               |the day
!!    wshddayo(9) |deg C         |average minimum temperature in watershed for
!!                               |the day
!!    wshddayo(12)|metric tons   |sediment yield from HRUs in watershed for day
!!    wshddayo(13)|metric tons   |sediment loading to ponds in watershed for day
!!    wshddayo(14)|metric tons   |sediment loading from ponds in watershed for
!!                               |day
!!    wshddayo(15)|metric tons   |net change in sediment level in ponds in
!!                               |watershed for day
!!    wshddayo(16)|metric tons   |sediment loading to wetlands for day
!!                               |in watershed
!!    wshddayo(17)|metric tons   |sediment loading to main channels from
!!                               |wetlands for day in watershed
!!    wshddayo(18)|metric tons   |net change in sediment in wetlands for day
!!                               |in watershed
!!    wshddayo(19)|m^3 H2O       |evaporation from ponds in watershed for day
!!    wshddayo(20)|m^3 H2O       |seepage from ponds in watershed for day
!!    wshddayo(21)|m^3 H2O       |precipitation on ponds in watershed for day
!!    wshddayo(22)|m^3 H2O       |volume of water entering ponds in watershed
!!                               |for day
!!    wshddayo(23)|m^3 H2O       |volume of water leaving ponds in watershed
!!                               |for day
!!    wshddayo(24)|m^3 H2O       |evaporation from wetlands for day in watershed
!!    wshddayo(25)|m^3 H2O       |seepage from wetlands for day in watershed
!!    wshddayo(26)|m^3 H2O       |precipitation on wetlands for day in watershed
!!    wshddayo(27)|m^3 H2O       |volume of water entering wetlands on day in
!!                               |watershed
!!    wshddayo(28)|m^3 H2O       |volume of water leaving wetlands on day in
!!                               |watershed
!!    wshddayo(33)|m^3 H2O       |net change in water volume of ponds in
!!                               |watershed for day
!!    wshddayo(35)|mm H2O        |amount of water stored in soil profile in
!!                               |watershed for day
!!    wshddayo(36)|mm H2O        |snow melt in watershed for day
!!    wshddayo(37)|mm H2O        |sublimation in watershed for day
!!    wshddayo(38)|mm H2O        |average amount of tributary channel
!!                               |transmission losses in watershed on day
!!    wshddayo(39)|mm H2O        |freezing rain/snow fall in watershed for day
!!    wshddayo(40)|kg N/ha       |organic N loading to stream in watershed for
!!                               |day
!!    wshddayo(41)|kg P/ha       |organic P loading to stream in watershed for
!!                               |day
!!    wshddayo(42)|kg N/ha       |nitrate loading to stream in surface runoff
!!                               |in watershed for day
!!    wshddayo(43)|kg P/ha       |soluble P loading to stream in watershed for
!!                               |day
!!    wshddayo(44)|kg N/ha       |plant uptake of N in watershed for day
!!    wshddayo(45)|kg N/ha       |nitrate loading to stream in lateral flow
!!                               |in watershed for day
!!    wshddayo(46)|kg N/ha       |nitrate percolation past bottom of soil
!!                               |profile in watershed for day
!!    wshddayo(104)|mm H2O        |groundwater contribution to stream in
!!                               |watershed on day
!!    wshddayo(105)|mm H2O        |amount of water moving from shallow aquifer
!!                               |to plants/soil profile in watershed on day
!!    wshddayo(106)|mm H2O        |deep aquifer recharge in watershed on day
!!    wshddayo(107)|mm H2O        |total amount of water entering both aquifers
!!                               |in watershed on day
!!    wshddayo(108)|mm H2O        |potential evapotranspiration in watershed
!!                               |on day
!!    wshddayo(109)|mm H2O        |drainage tile flow contribution to stream
!!                               |in watershed on day
!!    wshddayo(110)|kg/ha        |NO3 yield (gwq)
!!    wshddayo(111)|mm H2O       |NO3 yield (tile)
!!    wtrmon(1,:) |mm H2O        |evaporation from ponds in HRU for month
!!    wtrmon(2,:) |mm H2O        |seepage from ponds in HRU for month
!!    wtrmon(3,:) |mm H2O        |precipitation on ponds in HRU for month
!!    wtrmon(4,:) |mm H2O        |amount of water entering ponds in HRU for
!!                               |month
!!    wtrmon(5,:) |metric tons/ha|sediment entering ponds in HRU for month
!!    wtrmon(6,:) |mm H2O        |amount of water leaving ponds in HRU for
!!                               |month
!!    wtrmon(7,:) |metric tons/ha|sediment leaving ponds in HRU for month
!!    wtrmon(8,:) |mm H2O        |precipitation on wetlands in HRU for month
!!    wtrmon(9,:) |mm H2O        |volume of water entering wetlands from HRU
!!                               |for month
!!    wtrmon(10,:)|metric tons/ha|sediment loading to wetlands for month from
!!                               |HRU
!!    wtrmon(11,:)|mm H2O        |evaporation from wetlands in HRU for month
!!    wtrmon(12,:)|mm H2O        |seeepage from wetlands in HRU for month
!!    wtrmon(13,:)|mm H2O        |volume of water leaving wetlands in HRU
!!                               |for month
!!    wtrmon(14,:)|metric tons/ha|sediment loading from wetlands in HRU to main
!!                               |channel during month
!!    wtrmon(15,:)|mm H2O        |precipitation on potholes in HRU for month
!!    wtrmon(16,:)|mm H2O        |evaporation from potholes in HRU for month
!!    wtrmon(17,:)|mm H2O        |seepage from potholes in HRU for month
!!    wtrmon(18,:)|mm H2O        |water leaving potholes in HRU for month
!!    wtrmon(19,:)|mm H2O        |water entering potholes in HRU for month
!!    wtrmon(20,:)|metric tons/ha|sediment entering potholes in HRU for month
!!    wtrmon(21,:)|metric tons/ha|sediment leaving potholes in HRU for month
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    cnv         |none          |conversion factor (mm/ha => m^3)
!!    j           |none          |HRU number
!!    k           |none          |counter (pesticides)
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~

      use parm

      integer :: j, k
      real :: cnv
      integer :: hval

      j = 0
      j = ihru

      cnv = 0.
      cnv = 10. * hru_ha(j)

      !Edits by GWP get mm/mm SWC by layer to print in output.hru
      z = 0.
      ly = 0.

      do ly = 1, sol_nly(j)
          if (ly == 1) then
              z = sol_z(ly,j)
          else
              z = sol_z(ly,j) - sol_z(ly-1,j)
          end if
          vswc(ly,j) = sol_st(ly,j) / z + sol_wp(ly,j)
      end do
    !End of GWP edits

      if (curyr > nyskip) then
      !! HRU summations
        hrumono(1,j) = hrumono(1,j) + subp(j)
        hrumono(2,j) = hrumono(2,j) + snofall
        hrumono(3,j) = hrumono(3,j) + snomlt
        hrumono(4,j) = hrumono(4,j) + qday
        hrumono(5,j) = hrumono(5,j) + latq(j)
        hrumono(6,j) = hrumono(6,j) + gw_q(j)
        hrumono(7,j) = hrumono(7,j) + revapday
        hrumono(8,j) = hrumono(8,j) + gwseep
        hrumono(9,j) = hrumono(9,j) + rchrg(j)
        hrumono(10,j) = hrumono(10,j) + qdr(j)
        hrumono(11,j) = hrumono(11,j) + sepbtm(j)
        hrumono(12,j) = hrumono(12,j) + etday
        hrumono(13,j) = hrumono(13,j) + tloss
        hrumono(14,j) = hrumono(14,j) + sedyld(j) / hru_ha(j)
        hrumono(15,j) = hrumono(15,j) + ep_day
        hrumono(16,j) = hrumono(16,j) + es_day
        hrumono(17,j) = hrumono(17,j) + cfertn
        hrumono(18,j) = hrumono(18,j) + cfertp
        hrumono(19,j) = hrumono(19,j) + surfq(j)
        hrumono(20,j) = hrumono(20,j) + cnday(j)
        hrumono(21,j) = hrumono(21,j) + sol_cnsw(j)
         !hrumono(22,j) calculated in irrigate.f
        hrumono(23,j) = hrumono(23,j) + shallirr(j)
        hrumono(24,j) = hrumono(24,j) + deepirr(j)
        hrumono(25,j) = hrumono(25,j) + pet_day
        hrumono(26,j) = hrumono(26,j) + grazn
        hrumono(27,j) = hrumono(27,j) + grazp
        hrumono(28,j) = hrumono(28,j) + auton
        hrumono(29,j) = hrumono(29,j) + autop
        hrumono(30,j) = hrumono(30,j) + sol_tmp(2,j)
        hrumono(31,j) = hrumono(31,j) + (1.-strsw(j))
        hrumono(32,j) = hrumono(32,j) + (1.-strstmp(j))
        hrumono(33,j) = hrumono(33,j) + (1.-strsn(j))
        hrumono(34,j) = hrumono(34,j) + (1.-strsp(j))
        hrumono(35,j) = hrumono(35,j) + sedorgn(j)
        hrumono(36,j) = hrumono(36,j) + sedorgp(j)
        hrumono(37,j) = hrumono(37,j) + surqno3(j)
        hrumono(38,j) = hrumono(38,j) + latno3(j)
        hrumono(39,j) = hrumono(39,j) + surqsolp(j)
        hrumono(40,j) = hrumono(40,j) + nplnt(j)
        hrumono(41,j) = hrumono(41,j) + percn(j)
        hrumono(42,j) = hrumono(42,j) + pplnt(j)
        hrumono(43,j) = hrumono(43,j) + rmp1tl
        hrumono(44,j) = hrumono(44,j) + roctl
        hrumono(45,j) = hrumono(45,j) + fertn
        hrumono(46,j) = hrumono(46,j) + fertp
        hrumono(47,j) = hrumono(47,j) + fixn
        hrumono(48,j) = hrumono(48,j) + wdntl
        hrumono(49,j) = hrumono(49,j) + hmntl
        hrumono(50,j) = hrumono(50,j) + rwntl
        hrumono(51,j) = hrumono(51,j) + hmptl
        hrumono(52,j) = hrumono(52,j) + rmn2tl
        hrumono(53,j) = hrumono(53,j) + rmptl
        hrumono(54,j) = hrumono(54,j) + no3pcp
        hrumono(55,j) = hrumono(55,j) + tmx(j)
        hrumono(56,j) = hrumono(56,j) + tmn(j)
        hrumono(57,j) = hrumono(57,j) + tmpav(j)
        hrumono(58,j) = hrumono(58,j) + hru_ra(j)

        hrumono(61,j) = hrumono(61,j) + usle
        hrumono(62,j) = hrumono(62,j) + qtile
        hrumono(63,j) = hrumono(63,j) + bactrop + bactsedp
        hrumono(64,j) = hrumono(64,j) + bactrolp + bactsedlp
        hrumono(65,j) = hrumono(65,j) + no3gw(j)
        hrumono(66,j) = hrumono(66,j) + minpgw(j)
        hrumono(67,j) = hrumono(67,j) + sedminpa(j) + sedminps(j)
        hrumono(68,j) = hrumono(68,j) + tileno3(j)
        hrumono(69,j) = hrumono(69,j) + latno3(j)
        hrumono(70,j) = hrumono(70,j) + gw_qdeep(j)
        hrumono(71,j) = hrumono(71,j) + latq(j) - lpndloss - lwetloss
        hrumono(72,j) = hrumono(72,j) + vap_tile

# GWP edits

        !hval = 73

        !do ly = 1, sol_nly(j)
        !    hrumono(hval,j) = hrumono(hval,j) + vswc(ly,j)
        !    hval = hval + 1
        !end do

        hrumono(73,j) = hrumono(73,j) + vswc(1,j)
        hrumono(74,j) = hrumono(74,j) + vswc(2,j)
        hrumono(75,j) = hrumono(75,j) + vswc(3,j)
        hrumono(76,j) = hrumono(76,j) + vswc(4,j)
        hrumono(77,j) = hrumono(77,j) + vswc(5,j)
        hrumono(78,j) = hrumono(78,j) + vswc(6,j)
        hrumono(79,j) = hrumono(79,j) + vswc(7,j)
        hrumono(80,j) = hrumono(80,j) + vswc(8,j)
        hrumono(81,j) = hrumono(81,j) + vswc(9,j)
        hrumono(82,j) = hrumono(82,j) + vswc(10,j) !Can change based on how many layers need printed

# end edits

        wtrmon(1,j) = wtrmon(1,j) + pndev / cnv
        wtrmon(2,j) = wtrmon(2,j) + pndsep / cnv
        wtrmon(3,j) = wtrmon(3,j) + pndpcp / cnv
        wtrmon(4,j) = wtrmon(4,j) + pndflwi / cnv
        wtrmon(5,j) = wtrmon(5,j) + pndsedin / hru_ha(j)
        wtrmon(6,j) = wtrmon(6,j) + pndflwo / cnv
        wtrmon(7,j) = wtrmon(7,j) + pndsedo / hru_ha(j)
        wtrmon(8,j) = wtrmon(8,j) + wetpcp / cnv
        wtrmon(9,j) = wtrmon(9,j) + wetflwi / cnv
        wtrmon(10,j) = wtrmon(10,j) + wetsedi / hru_ha(j)
        wtrmon(11,j) = wtrmon(11,j) + wetev / cnv
        wtrmon(12,j) = wtrmon(12,j) + wetsep / cnv
        wtrmon(13,j) = wtrmon(13,j) + wetflwo / cnv
        wtrmon(14,j) = wtrmon(14,j) + wetsedo / hru_ha(j)
        wtrmon(15,j) = wtrmon(15,j) + potpcpmm
        wtrmon(16,j) = wtrmon(16,j) + potevmm
        wtrmon(17,j) = wtrmon(17,j) + potsepmm
        wtrmon(18,j) = wtrmon(18,j) + potflwo
        wtrmon(19,j) = wtrmon(19,j) + potflwi(j) / cnv
        wtrmon(20,j) = wtrmon(20,j) + potsedi(j) / hru_ha(j)
        wtrmon(21,j) = wtrmon(21,j) + potsedo / hru_ha(j)

      !! watershed summations
        if (ffcst == 0 .and. iscen == 1) then
        wshddayo(1) = wshddayo(1) + subp(j) * hru_dafr(j)
        wshddayo(3) = wshddayo(3) + surfq(j) * hru_dafr(j)
        wshddayo(4) = wshddayo(4) + latq(j) * hru_dafr(j)
        wshddayo(5) = wshddayo(5) + sepbtm(j) * hru_dafr(j)
        wshddayo(6) = wshddayo(6) + qdr(j) * hru_dafr(j)
        wshddayo(7) = wshddayo(7) + etday * hru_dafr(j)
        wshddayo(8) = wshddayo(8) + tmx(j) * hru_dafr(j)
        wshddayo(9) = wshddayo(9) + tmn(j) * hru_dafr(j)
        wshddayo(12) = wshddayo(12) + sedyld(j)
        wshddayo(13) = wshddayo(13) + pndsedin
        wshddayo(14) = wshddayo(14) + pndsedo
        wshddayo(15) = wshddayo(15) + pndsedc
        wshddayo(16) = wshddayo(16) + wetsedi
        wshddayo(17) = wshddayo(17) + wetsedo
        wshddayo(18) = wshddayo(18) + wetsedc
        wshddayo(19) = wshddayo(19) + pndev
        wshddayo(20) = wshddayo(20) + pndsep
        wshddayo(21) = wshddayo(21) + pndpcp
        wshddayo(22) = wshddayo(22) + pndflwi
        wshddayo(23) = wshddayo(23) + pndflwo
        wshddayo(24) = wshddayo(24) + wetev
        wshddayo(25) = wshddayo(25) + wetsep
        wshddayo(26) = wshddayo(26) + wetpcp
        wshddayo(27) = wshddayo(27) + wetflwi
        wshddayo(28) = wshddayo(28) + wetflwo
        wshddayo(33) = wshddayo(33) + pndflwi - pndflwo
        wshddayo(35) = wshddayo(35) + sol_sw(j) * hru_dafr(j)
        wshddayo(36) = wshddayo(36) + snomlt * hru_dafr(j)
        wshddayo(37) = wshddayo(37) + snoev * hru_dafr(j)
        wshddayo(38) = wshddayo(38) + tloss * hru_dafr(j)
        wshddayo(39) = wshddayo(39) + snofall * hru_dafr(j)
        wshddayo(40) = wshddayo(40) + sedorgn(j) * hru_dafr(j)
        wshddayo(41) = wshddayo(41) + sedorgp(j) * hru_dafr(j)
        wshddayo(42) = wshddayo(42) + surqno3(j) * hru_dafr(j)
        wshddayo(43) = wshddayo(43) + surqsolp(j) * hru_dafr(j)
        wshddayo(44) = wshddayo(44) + nplnt(j) * hru_dafr(j)
        wshddayo(45) = wshddayo(45) + latno3(j) * hru_dafr(j)
        wshddayo(46) = wshddayo(46) + percn(j) * hru_dafr(j)

        !! wshddayo(47) - wshddayo (103) not used

        wshddayo(104) = wshddayo(104) + gw_q(j) * hru_dafr(j)
        wshddayo(105) = wshddayo(105) + revapday * hru_dafr(j)
        wshddayo(106) = wshddayo(106) + gwseep * hru_dafr(j)
        wshddayo(107) = wshddayo(107) + rchrg(j) * hru_dafr(j)
        wshddayo(108) = wshddayo(108) + pet_day * hru_dafr(j)
        wshddayo(109) = wshddayo(109) + qtile * hru_dafr(j)
        wshddayo(110) = wshddayo(110) + no3gw(j) * hru_dafr(j)
        wshddayo(111) = wshddayo(111) + tileno3(j) * hru_dafr(j)
        wshddayo(113) = wshddayo(113) + gw_qdeep(j) * hru_dafr(j)
          do ii=1,mstdo
            if(wshddayo(ii).ne.wshddayo(ii)) wshddayo(ii) = 0  !! float error debug, Jaehak Jeong, 2011 Feb
          end do

        else if (ffcst == 1) then
          if (j == 1) fcstcnt = fcstcnt + 1
          fcstaao(1) = fcstaao(1) + subp(j) * hru_dafr(j)
          fcstaao(2) = fcstaao(2) + snofall * hru_dafr(j)
          fcstaao(3) = fcstaao(3) + snomlt * hru_dafr(j)
          fcstaao(4) = fcstaao(4) + snoev * hru_dafr(j)
          fcstaao(5) = fcstaao(5) + (qday + tloss) * hru_dafr(j)
          fcstaao(6) = fcstaao(6) + latq(j) * hru_dafr(j)
          fcstaao(7) = fcstaao(7) + qtile * hru_dafr(j)
          fcstaao(8) = fcstaao(8) + gw_q(j) * hru_dafr(j)
          fcstaao(9) = fcstaao(9) + revapday * hru_dafr(j)
          fcstaao(10) = fcstaao(10) + gwseep * hru_dafr(j)
          fcstaao(11) = fcstaao(11) + rchrg(j) * hru_dafr(j)
          fcstaao(12) = fcstaao(12) + qdr(j) * hru_dafr(j)
          fcstaao(13) = fcstaao(13) + sepbtm(j) * hru_dafr(j)
          fcstaao(14) = fcstaao(14) + etday * hru_dafr(j)
          fcstaao(15) = fcstaao(15) + pet_day * hru_dafr(j)
          fcstaao(16) = fcstaao(16) + tloss * hru_dafr(j)
        end if

        !! pesticide summary
        if (hrupest(j) == 1) then
          do k = 1, npmx
            !! HRU summary
            hrupstd(k,1,j) = pst_surq(k,j) * 1.e6 * hru_ha(j)
            hrupstd(k,2,j) = pst_sed(k,j) * 1.e6 * hru_ha(j)
            hrupstd(k,3,j) = (pst_surq(k,j) + pst_sed(k,j)) * 1.e6
            hrupstd(k,4,j) = lat_pst(k) * 1.e6 * hru_ha(j)
            !! watershed summary
            wpstdayo(k,1) = wpstdayo(k,1) + pst_surq(k,j) * hru_dafr(j)
     &                                                            * 1.e6
            wpstdayo(k,2) = wpstdayo(k,2) + pst_sed(k,j) * hru_dafr(j) *
     &                                                              1.e6
            wpstdayo(k,3) = wpstdayo(k,3) + pstsol(k) * hru_dafr(j)
            wpstdayo(k,4) = wpstdayo(k,4) + lat_pst(k) * hru_dafr(j)
          end do
        end if
      end if

      return
      end


      subroutine wshpas(year,day,istat)
c
c     + + + PURPOSE + + +
c
c     Controls the reading and writing of hydrologic information
c     from the hillslope (hillslope/watershed version) to the
c     channels and impoundments (watershed version).
c
c     Called from: MAIN, SR CONTIN
c     Author(s): Ascough II, C. Baffaut
c     Reference in User Guide:
c
c     Version:
c     Date recoded:
c     Recoded by:
c
c     + + + KEYWORDS + + +
c
c     + + + PARAMETERS + + +
c
      include 'pmxelm.inc'
      include 'pmxhil.inc'
      include 'pmxnsl.inc'
      include 'pmxpln.inc'
      include 'pmxprt.inc'
      include 'pmxpts.inc'
      include 'pmxslp.inc'
      include 'pmxtim.inc'
      include 'pmxseg.inc'
c Added by L. Wang, 12/04/2009.
      include 'pmxchr.inc'
c End adding.
c
c     + + + ARGUMENT DECLARATIONS + + +
c
      integer day, istat, year
c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     day   - julian date
c     istat - flag for read/write status
c     year  - current climate file simulation year
c
c     + + + COMMON BLOCKS + + +
c
      include 'ccliyr.inc'
      include 'cdata1.inc'
      include 'cdata3.inc'
      include 'cdiss11.inc'
      include 'cdist.inc'
      include 'cefflen.inc'
      include 'cenrpas.inc'
      include 'chydrol.inc'
      include 'cpart.inc'
      include 'csedld.inc'
      include 'cslope.inc'
      include 'cslpopt.inc'
      include 'cstore.inc'
      include 'cstruc.inc'
      include 'cver.inc'
      include 'cwater.inc'
      include 'cwshed.inc'
      include 'cseddet.inc'
c Added by L. Wang, 12/04/2009.
      include 'cchrt.inc'
c End adding.
      include 'ccdrain.inc'
c
c     + + + LOCAL VARIABLES + + +
c
      real tmpdur(mxhill), tmptcs(mxhill), tmpalp(mxhill),
     1    tmpsed(mxpart,mxhill), tmpdia(mxpart,mxhill),
     1    tmpflw(mxpart,mxhill), oalpha, tcs, tcstmp, tmpdet(mxhill),
     1    tmpdep(mxhill),drrunv,tmpdrf(mxhill),tmpdrv(mxhill)
c Added by L. Wang, 12/04/2009.
      real qptsum, qpsum
c End adding.
c
      integer i, iflag, j, k, l, m, ndays, tmpbyr, tmpnyr
c
      character*8 event(mxhill)
c
c     + + + LOCAL DEFINITIONS + + +
c
c     tmpdur(mxhill)  - storage variable for storm duration
c     tmptcs(mxhill)  - storage variable for overland flow time
c                       of concentration
c     tmpalp(mxhill)  - storage variable for overland flow alpha
c     tmprof(mxhill)  - storage variable for runoff depth |
c     tmpvol(mxhill)  - storage variable for runoff volume| Those are now in
c     tmppkr(mxhill)  - storage variable for peak runoff  | cstore.inc
c     tmpsed(mxpart,mxhill)  - storage variable for sediment
c                              concentration
c     tmpdia(mxpart,mxhill)  - storage variable for particle
c                              size diameter
c     tmpflw(mxpart,mxhill)  - storage variable for fraction of sediment
c                              in each particle class
c     oalpha  -
c     tcs     -
c     tcstmp  -
c     i -
c     iflag   - flag set if runoff event occurs on any hillslope
c     j -
c     k -
c     l -
c     m -
c     ndays   - number of days in a year
c     event(mxhill)   - describes runoff or no runoff event
c     tmpbyr - beginning year in climate file
c     tmpnyr - maximum years value read in for each hillslope
c
c     + + + SAVES + + +
c
c     + + + SUBROUTINES CALLED + + +
c
c     table
c
c     + + + DATA INITIALIZATIONS + + +
c
c     + + + END SPECIFICATIONS + + +
c
c
      drrunv = 0.0

      if (istat.eq.1) then
c         calculate a tile drainage volume
          if (drainq(nplane).gt.0.0) then
             drrunv = drainq(nplane) * slplen(nplane)
     1        * fwidth(nplane)
          endif
c
c       storing information from hillslope(s) to pass files
c       for later writing to a master watershed pass file
c       (only if there is runoff from the last hillslope ofe
c       for current day)
c
c       write out variables that change with hillslopes but not with
c       time (climate file, maximum simulation years, beginnning year
c       of climate file, hillshillslope area, and particle size
c       diameter) to the top of the hillslope pass file(s)
c
        if ((year.eq.ibyear).and.(day.eq.1)) write (48,1100)
     1      wshcli(ihill), nyear, ibyear, harea(ihill), npart, (
     1      dia(i,nplane),i = 1,npart)
c
        if (runoff(nplane).ge.0.001) then
c
          event(1) = 'EVENT   '
c
CX    Added by Arthur Xu, 05/2000
         if(sbrunf(nplane).gt.0.00)then
           sbrunv(nplane) = sbrunf(nplane) * slplen(nplane)
     1        * fwidth(nplane)
         else
            sbrunf(nplane) = 0.0
            sbrunv(nplane) = 0.0
          end if
cx      The T1-IF-THEN-ELSE-ENDIF block is added to take lateral
cx      flow into account    ------ Arthur May,00
cx    End adding
c

c         calculate overland flow time of concentration (hr)
c         and alpha value for use in the watershed version
c
          tcs = (0.0216*((hleng*hmann)**0.75)) / ((((runoff(nplane)/dur)
     1        *3.6e06)**0.25)*(hslop**0.375))
c
c         calculation of overland flow alpha
c
          tcstmp = tcs * 3600.0
c
          oalpha = tcstmp * peakro(nplane) * harea(ihill) /
     1        runvol(nplane)
c
c         check for minimum bounds on oalpha
c
          if (oalpha.lt.(tcs/24.0)) oalpha = tcs / 24.0
c
c         check for maximum bounds on oalpha
c
c         alpha temporarily allowed to be greater than 1.0
c
c         if (oalpha.gt.1.0) oalpha = 1.0
c
cx    Modified by Arthur Xu, 05/2000 Incorporated in by S. Dun 12/2003
c     Added tile drainage (drainq and drrunv)to pass file - 3/10/2010 - jrf
        write (48,1000) event(1), year, day, dur, tcs, oalpha,
     1        runoff(nplane), runvol(nplane),sbrunf(nplane),
     1        sbrunv(nplane), drainq(nplane), drrunv, peakro(nplane) *
     1        harea(ihill), tdet(ihill), tdep(ihill), (
     1        sedcon(i,nplane),i = 1,npart), (frcflw(i,nplane),i = 1,
     1        npart)
cx
        else if (sbrunf(nplane).gt.0.00)then
          sbrunv(nplane)=sbrunf(nplane) * slplen(nplane)
     1        * fwidth(nplane)
          if ((sbrunv(nplane).gt.0.01).or.(drainq(nplane).gt.0.0)) then
c    Added tile drainage (drainq and drrunv)to pass file - 3/10/2010 - jrf
             event(1)= 'SUBEVENT'
             write(48,1000) event(1), year, day, sbrunf(nplane),
     1            sbrunv(nplane),drainq(nplane), drrunv
          else
             event(1) = 'NO EVENT'
             write (48,1000) event(1), year, day
          endif
cx    End Modifying.
c
        else if (drainq(nplane).gt.0.0) then
          event(1) = 'SUBEVENT'
          sbrunv(nplane) = 0.0
          sbrunf(nplane) = 0.0
c    Added tile drainage (drainq and drrunv)to pass file - 3/10/2010 - jrf
          write(48,1000) event(1), year, day, sbrunf(nplane),
     1            sbrunv(nplane),drainq(nplane), drrunv
        else
c
          event(1) = 'NO EVENT'
          write (48,1000) event(1), year, day
        end if
c
      end if
c
c     This reads in the individual hillslope pass files and writes out
c     a watershed pass file.
      if (istat.eq.2) then
c
        do 10 i = 1, nhill
c
c       Bug Fix: Mitch Nelson (KSU) 11-14-2001
c        - If nhill = 47, then j becomes 49, and an error may occur.
c        - Fix: replace next two lines with j = i + 70.
c          if (i.lt.5) j = i
c          if (i.ge.5) j = i + 2
            j = i + 70
c
c         open hillslope pass files
c
c         LAHEY compiler needs status = 'old'
c
         open (unit=j,file=pasfil(i),status='old')
c
c         SALFORD compiler needs status = 'readonly'
c
c          open (unit=j,file=pasfil(i),status='readonly')
c
c         read in stored information from initial lines of hillslope
c         pass files
c
          read (j,1100) wshcli(i), tmpnyr, tmpbyr, harea(i), npart, (
     1        tmpdia(l,i),l = 1,npart)
c
c         check hillslopes to determine maximum simulation years and
c         for consistency in beginning year of climate files
c
          if (i.eq.1) then
            maxyrs = tmpnyr
            iwsbyr = tmpbyr
          end if
c
          if (i.gt.1) then
c
            if (iwsbyr.ne.tmpbyr) then
              write (6,1900) iwsbyr, ibyear
              stop
            end if
c
            if (tmpnyr.lt.maxyrs) maxyrs = tmpnyr
c
          end if
c
   10   continue
c
        write (49,1600) ver, nhill, maxyrs, iwsbyr
c
        do 20 i = 1, nhill
c
c         write out hillslope climate file, particle size
c         diameter (m), and drainage area information (m^2) to
c         permanent watershed pass file
c
          write (49,1700) i, wshcli(i), (tmpdia(l,i),l = 1,npart),
     1        harea(i)
c
c         moved assignment here to work with older FORTRAN semantics jrf 2/16/2012
          hsarea(i) = harea(i)
   20   continue
c
        write (49,1800)
c
        year = iwsbyr
cw Added by L. Wang, 12/04/2009
        qptsum = 0.0
        qpsum = 0.0
cw End adding
c
        do 60 i = 1, maxyrs
c
c         check for leap year
c
          if (mod(year,4).ne.0) ndays = 365
          if (mod(year,4).eq.0) ndays = 366
c
c         check for simulation mode (single storm or continuous)
c
          if (imodel.eq.2) ndays = 1
c
          do 50 j = 1, ndays
c
            iflag = 0
c
            do 40 k = 1, nhill
c
c             Bug Fix: Mitch Nelson (KSU) 11-14-2001
c                 adjust as above, replace next two lines with m=k+70
c              if (k.lt.5) m = k
c              if (k.ge.5) m = k + 2
                m = k+70
c
c             read remainder of information in hillslope pass files
c
              read (m,1000) event(k)
c
              if (event(k).eq.'EVENT   ') then
                backspace (m)
cx    Modified by Arthur Xu, 05/2000, added tile drainage 3/10/2010 - jrf
                read (m,1000) event(k), year, day, tmpdur(k),
     1              tmptcs(k), tmpalp(k), tmprof(k), tmpvol(k),
     1              tmpsbf(k),tmpsbv(k), tmpdrf(k), tmpdrv(k),
     1              tmppkr(k), tmpdet(k), tmpdep(k), (tmpsed(l,k),l = 1,
     1              npart), (tmpflw(l,k),l = 1,npart)
cx    End Modifying.
                iflag = 1
cx    Added by Arthur Xu, 05/2000, added tile drainage 3/10/2010 - jrf
            else if(event(k).eq.'SUBEVENT')then
              backspace(m)
              read(m,1000) event(k), year, day, tmpsbf(k),
     1            tmpsbv(k), tmpdrf(k), tmpdrv(k)
              if (iflag.NE.1) iflag = 2
c
              tmpdur(k) = 0.0
              tmptcs(k) = 0.0
              tmpalp(k) = 0.0
              tmprof(k) = 0.0
              tmpvol(k) = 0.0
              tmppkr(k) = 0.0
              tmpdet(k) = 0.0
              tmpdep(k) = 0.0
c
              do 25 l = 1, npart
                tmpsed(l,k) = 0.0
                tmpflw(l,k) = 0.0
   25         continue
cx    End adding.
              else
                tmpdur(k) = 0.0
                tmptcs(k) = 0.0
                tmpalp(k) = 0.0
                tmprof(k) = 0.0
                tmpvol(k) = 0.0
                tmppkr(k) = 0.0
                tmpdet(k) = 0.0
                tmpdep(k) = 0.0
cx    Added by Arthur Xu, 05/2000
                tmpsbf(k) = 0.0
                tmpsbv(k) = 0.0
cx    End adding
c
                tmpdrf(k) = 0.0
                tmpdrv(k) = 0.0

                do 30 l = 1, npart
                  tmpsed(l,k) = 0.0
                  tmpflw(l,k) = 0.0
   30           continue
c
              end if
c
   40       continue
c
c           write out hillslope hydrology, sediment concentration,
c           and particle size information to permanent pass file
c
c           no runoff event on current day for ANY HILLSLOPE
c           in the watershed
c
            if (iflag.eq.0) write (49,1200) year, j
c
c           runoff event on current day for ONE OR MORE hillslopes
c           in the watershed
c
c           writing out hillslope storm duration (s), overland flow
c           time of concentration (hr), overland flow alpha
c           parameter (unitless), runoff (m), runoff volume (m^3),
c           peak runoff (m^3/s), total detachment (kg), total
c           deposition (kg), sediment concentration (kg/m^3),
c           and fraction of each particle type (dimensionless)
c
            if (iflag.eq.1) then
              write (49,1300) year, day
              write (49,1400) (tmpdur(k),k = 1,nhill)
              write (49,1400) (tmptcs(k),k = 1,nhill)
              write (49,1400) (tmpalp(k),k = 1,nhill)
              write (49,1400) (tmprof(k),k = 1,nhill)
              write (49,1400) (tmpvol(k),k = 1,nhill)
cx    Added by Arthur Xu, 05/2000
              write (49,1400) (tmpsbf(k), k = 1, nhill)
              write (49,1400) (tmpsbv(k), k = 1, nhill)
cx    End adding
c     Added tile drainage 3/10/2010 - jrf
              write (49,1400) (tmpdrf(k), k = 1, nhill)
              write (49,1400) (tmpdrv(k), k = 1, nhill)

              write (49,1400) (tmppkr(k),k = 1,nhill)
              write (49,1400) (tmpdet(k),k = 1,nhill)
              write (49,1400) (tmpdep(k),k = 1,nhill)
              write (49,1500) ((tmpsed(l,k),l = 1,npart),k = 1,nhill)
              write (49,1500) ((tmpflw(l,k),l = 1,npart),k = 1,nhill)
cw Added by L. Wang, 12/04/2009
              do k = 1,nhill
                qptsum = qptsum + (tmppkr(k) + tmpsbv(k) / 86400.)
     1                   * tmptcs(k) * 3600.
	          qpsum = qpsum + tmppkr(k) + tmpsbv(k) / 86400.
	        enddo
cw End adding
cx    Added by Arthur Xu, 05/2000
            else if (iflag.eq.2)then
              write(49,1350)year,day
              write(49,1400)(tmpsbf(k),k=1, nhill)
              write(49,1400)(tmpsbv(k),k=1, nhill)
c    Added tile drainage 3/10/2010 - jrf
              write (49,1400)(tmpdrf(k), k = 1, nhill)
              write (49,1400)(tmpdrv(k), k = 1, nhill)
cx    End adding
            end if
c
   50     continue
c
          year = year + 1
c
   60   continue
cw Added by L. Wang, 12/04/2009
        trise = qptsum/qpsum
cw Change back to user-defined time step, L. Wang, 6/13/2012
cw        dtchr = trise/10.
cw	    if(dtchr < dtlowl) dtchr = dtlowl
cw	    if(imodel == 1) then
cw	       if(dtchr > dtupl1) dtchr = dtupl1
cw	    else
cw	       if(dtchr > dtupl2) dtchr = dtupl2
cw	    endif
cw	    ntchr = 86400./dtchr + 0.99
cw	    if(ntchr > mxtchr) ntchr = mxtchr
cw	    dtchr = 86400./ntchr
cw End adding
c
        close (unit=49)
c
c       Bug Fix: Mitch Neilsen (KSU)  11-14-2001
c                  -- close descriptors 71 to 70+nhill
c        do 70 i = 1, nhill + 2
          do 70 i = 71, 70+nhill
c          if (.not.((i.eq.5).or.(i.eq.6))) then
            close (unit=i)
c          end if
   70   continue
c
      end if
c
      return
c
cx Modified by Arthur Xu 05/2000

 1000 format (a8,2x,2(i5,1x),5x,10(e11.5,1x),2(5x,5(e11.5,1x)))
cx End Modifying.
 1100 format (a,/,i5,5x,i5,/,e10.5,/,i3,4x,5(e11.5,1x))
 1200 format ('NO EVENT',2x,2(i5,1x))
 1300 format ('EVENT   ',2x,2(i5,1x))
cx Added by Arthur Xu 05/2000
 1350 format ('SUBEVENT',2x,2(i5,1x))
cx End adding
 1400 format (75(e11.5,1x))
 1500 format (75(5(e11.5,1x)))
 1600 format ('GENERAL SIMULATION INFORMATION',//,f9.3,
     1    '   --> VERSION NUMBER',/,i6,
     1    '   --> NUMBER OF UNIQUE HILLSLOPES IN WATERSHED',/,i6,
     1    '   --> WATERSHED MAXIMUM SIMULATION TIME (YEARS)',/,i6,
     1    '   --> BEGINNING YEAR OF WATERSHED CLIMATE FILE',//,
     1    'SPECIFIC SIMULATION INFORMATION',//,'HILLSLOPE #',6x,
     1    'CLIMATE FILE',39x,'PARTICLE DIAMETER (M)',44x,'AREA'/)
 1700 format ('HILLSLOPE ',i2,5x,a,5(e11.5,1x),5x,e10.5)
 1800 format (/'BEGIN HILLSLOPE HYDROLOGY AND SEDIMENT INFORMATION'/)
 1900 format (//'*** BEGINNING YEARS OF HILLSLOPE CLIMATE FILES ',
     1    ' ARE NOT THE SAME ***',//,'** SIMULATION STOPPED ***'//)
      end