hydro/Routing/Overland/module_overland_control.F90

   1 ! module overland_control_data.F
   2 ! Purpose: This module contains the overland_control_struct class. This types holds
   3 ! the control variables used in the overland routing code
   4 ! National Water Center
   5 ! Responsibility: Donald W Johnson donald.w.johnson@noaa.gov
   6 ! Authors: Donald W Johnson, Nels Frazier
   7
   8 module overland_control
   9    !type that holds the variables that are inputs to or outputs of the routing code
  10    ! along with book keeping variables
  11
  12    !TODO change output integers to variables that are set dependant on the running system
  13    ! example WCOSS
  14
  15    type overland_control_struct
  16       ! outputs
  17       !FIXME surface_water_head* should be moved to surface_water_depth since head != depth.  head is elevation + pressure/energy, not depth (FRED and TREY meeting feb 27, 2018)
  18       ! replaced with surface_water_head_lsm
  19       !real, allocatable, dimension(:,:) :: sfcheadrt
  20       ! depth of water on the surface (after routing), passed to the land surface model (mm) on the land surface grid.
  21       ! LSM combines this with canopy water for infiltration excess at the next time step.
  22       real, allocatable, dimension(:,:) :: surface_water_head_lsm
  23
  24       ! replaced with surface_water_head_routing
  25       !real, allocatable, dimension(:,:) :: sfcheadsubrt
  26       ! surface head on the routing grid during integration, input to surface_water_head_lsm for the next time step
  27       real, allocatable, dimension(:,:) :: surface_water_head_routing
  28
  29       !PROPOSED Decouple the surface_water_head_lsm and surface_water_head_routing into a cleaner interface (only one surface_water_head in overland)
  30       !This will have to be done once the land surface interface is better hashed out.
  31
  32       ! inputs
  33       !FIXME infiltration_excess is a DEPTH (mm) so be explicit and call it infiltration_excess_depth (FRED and TREY meeting feb 27, 2018)
  34       ! replaced with infiltration_excess
  35       !real, allocatable, dimension(:,:) :: infxsubrt
  36       ! infiltration excess from the land surface model (mm) on the routing grid
  37       real, pointer, dimension(:,:) :: infiltration_excess => null()
  38
  39       ! miscellaneous bookkeeping
  40
  41       ! DEPRECATE TODO NJF and DJG Feb 13, 2018.  Remove for fall 2019 release
  42       ! Is passed around overland routing as an output var, renamed to qsfc in route_overland<1,2>
  43       ! qsfc in overland1 is intent(in), overland2 intent(inout). qsfc NEVER USED
  44       real, allocatable, dimension(:,:) :: dhrt
  45
  46       ! replaced with boundary_flux
  47       !FIXME NOT A FLUX!!!! rename to a better descriptor (FRED and TREY meeting feb 27, 2018)
  48       !real, allocatable, dimension(:,:) :: qbdryrt
  49       ! flux of boundary cells at a given time step, + into the domain, - out of the domain (mm)
  50       real, allocatable, dimension(:,:) :: boundary_flux
  51
  52       ! replaced with boundary_flux_total
  53       !real :: qbdrytrt
  54       ! accumulation of all boundary cell fluxes per time step (<mm>)
  55       real :: boundary_flux_total
  56
  57
  58       contains
  59       procedure :: init => overland_control_init
  60       procedure :: destroy => overland_control_destroy
  61       end type overland_control_struct
  62
  63     contains
  64
  65 ! this procedure allocates memory for an overland_control structure that has not been allocated
  66 ! if the structure has been allocated an error will be logged
  67
  68 subroutine overland_control_init(this,lsm_ix,lsm_jx,rt_ix,rt_jx)
  69     implicit none
  70     class(overland_control_struct), intent(inout) :: this ! the type object being initalized
  71     integer, intent(in) :: lsm_ix                    ! land surface x size
  72     integer, intent(in) :: lsm_jx                    ! land surface y size
  73     integer, intent(in) :: rt_ix                     ! routing grid x size
  74     integer, intent(in) :: rt_jx                     ! routing grid y size
  75
  76     logical :: allocation_error = .false.
  77
  78    this%boundary_flux_total = 0.0
  79
  80     ! allocate surface head
  81     if ( .not. allocated(this%surface_water_head_lsm) ) then
  82         allocate( this%surface_water_head_lsm(lsm_ix,lsm_jx) )
  83         this%surface_water_head_lsm = 0.0
  84     else
  85         allocation_error = .true.
  86     end if
  87
  88     ! allocate surface head
  89
  90     if ( .not. allocated(this%surface_water_head_routing) ) then
  91         allocate( this%surface_water_head_routing(rt_ix,rt_jx) )
  92         this%surface_water_head_routing = 0.0
  93     else
  94         allocation_error = .true.
  95     end if
  96
  97     ! allocate inflitration excess
  98     if ( .not. associated(this%infiltration_excess) ) then
  99         allocate( this%infiltration_excess(rt_ix,rt_jx) )
 100         this%infiltration_excess = 0.0
 101     else
 102         allocation_error = .true.
 103     end if
 104
 105     ! DEPRECATE TODO NJF and DJG Feb 13, 2018.  Remove for fall 2019 release
 106     ! Is passed around overland routing as an output var, renamed to qsfc in route_overland<1,2>
 107     ! qsfc in overland1 is intent(in), overland2 intent(inout). qsfc NEVER USED
 108     ! allocate dhrt
 109     if ( .not. allocated(this%dhrt) ) then
 110          allocate( this%dhrt(rt_ix,rt_jx) )
 111          this%dhrt = 0.0
 112     else
 113         allocation_error = .true.
 114     end if
 115
 116     ! allocate qbdryrt
 117     if ( .not. allocated(this%boundary_flux) ) then
 118          allocate( this%boundary_flux(rt_ix,rt_jx) )          ! allocate qbdryrt
 119          this%boundary_flux = 0.0
 120     else
 121         allocation_error = .true.
 122     end if
 123
 124     if ( allocation_error ) &
 125         write(0,*) "attempt to allocate data in members of overland control structure&
 126         &that where allready allocated. The allocated members where not changed"
 127
 128 end subroutine overland_control_init
 129
 130 ! this procedure deallocates and overland_control structure that was initalized with
 131 ! overland_control_init
 132
 133 subroutine overland_control_destroy(this)
 134     implicit none
 135     class(overland_control_struct), intent(inout) :: this ! the type object being destroyed
 136
 137     logical :: allocation_error = .false.
 138
 139     ! deallocate surface head
 140     if ( allocated(this%surface_water_head_lsm) ) then
 141         deallocate( this%surface_water_head_lsm )
 142     else
 143         allocation_error = .true.
 144     end if
 145
 146     ! deallocate surface head
 147     if ( allocated(this%surface_water_head_routing) ) then
 148         deallocate( this%surface_water_head_routing )
 149     else
 150         allocation_error = .true.
 151     end if
 152
 153     ! deallocate inflitration excess
 154     if ( associated(this%infiltration_excess) ) then
 155         deallocate( this%infiltration_excess)
 156     else
 157         allocation_error = .true.
 158     end if
 159
 160     ! deallocate dhrt
 161     if ( allocated(this%dhrt) ) then
 162          deallocate( this%dhrt )
 163     else
 164         allocation_error = .true.
 165     end if
 166
 167     ! deallocate qbdryrt
 168     if ( allocated(this%boundary_flux) ) then
 169          deallocate( this%boundary_flux )          ! deallocate boundary_flux
 170     else
 171         allocation_error = .true.
 172     end if
 173
 174     if ( allocation_error ) &
 175         write(0,*) "attempt to deallocate data in members of overland control structure&
 176         &that where not allready allocated. The unallocated members where not changed"
 177 end subroutine overland_control_destroy
 178 end module overland_control