hydro/Routing/Subsurface/module_subsurface_properties.F

   1 module module_subsurface_properties
   2     use overland_data
   3     implicit none
   4
   5     type subsurface_properties_interface
   6         ! disaggregated lateral hydraulic conductivity, on the routing grid, with adjustment factor applied (Noah_distr_routing.F: 2641*) LKSAT*LKSATFAC*[0..1]
   7         real, allocatable, dimension(:,:) :: lksatrt
   8
   9         ! water table depth (meters) (module_HYDRO_io.F: 1962*)
  10         real, allocatable, dimension(:,:) :: zwattablrt
  11
  12         ! soil depth on routing grid
  13         real, allocatable, dimension(:,:) :: soldeprt
  14
  15         !soil depth by layer
  16         real, allocatable, dimension(:) :: sldpth
  17
  18         ! need info
  19         real, dimension(100) :: zsoil
  20
  21         ! shared properties -- the following variables are shared from overland properties module
  22
  23         ! terrian slope in the x direction (m/m)
  24         real, pointer, dimension(:,:) :: surface_slope_x => null()
  25
  26         ! terrian slope in the y direction (m/m)
  27         real, pointer, dimension(:,:) :: surface_slope_y => null()
  28
  29         ! terrain surface slope in 8 ordinal directions (m/m)                                                                  !
  30         ! TODO verify this correct, check with Wei?
  31         !                      1
  32         !                      |
  33         !                  8       2
  34         !                    \   /
  35         !                 7__     __ 3
  36         !
  37         !                    /   \
  38         !                   6     4
  39         !                      |
  40         !                      5
  41         !
  42         real, pointer, dimension(:,:,:) :: surface_slope => null()
  43
  44         ! index of neighboring cell in the direction of steepest terrain surface slope, used with surface_slope
  45         integer, pointer, dimension(:,:,:) :: max_surface_slope_index => null()
  46
  47         ! centerpoint distance to each neighbor (m)
  48         real, pointer, dimension(:,:,:) :: distance_to_neighbor => null()
  49
  50         ! disaggregated lksat decay exponent
  51         real, allocatable, dimension(:,:) :: nexprt
  52
  53     contains
  54
  55         procedure :: init => subsurface_properties_init
  56         procedure :: destroy => subsurface_properties_destroy
  57     end type subsurface_properties_interface
  58
  59 contains
  60
  61     subroutine subsurface_properties_init(this,ix,jx,nsoil,overland_data)
  62         implicit none
  63         class(subsurface_properties_interface), intent(inout) :: this ! the type object being initalized
  64         integer, intent(in) :: ix                     ! x grid size
  65         integer, intent(in) :: jx                     ! y grid size
  66         integer, intent(in) :: nsoil                  ! number of soil layers
  67         class(overland_struct), intent(inout) :: overland_data
  68
  69         logical :: allocation_error = .false.
  70
  71         ! allocate the array only if not already allocated
  72         if ( .not. allocated(this%lksatrt) ) then
  73             allocate( this%lksatrt(ix,jx) )
  74             this%lksatrt = 0.0
  75         else
  76             allocation_error = .true.
  77         end if
  78
  79         ! allocate the array only if not already allocated
  80         if ( .not. allocated(this%zwattablrt) ) then
  81             allocate( this%zwattablrt(ix,jx) )
  82             this%zwattablrt = 0.0
  83         else
  84             allocation_error = .true.
  85         end if
  86
  87         ! allocate the array only if not already allocated
  88         if ( .not. allocated(this%soldeprt) ) then
  89             allocate( this%soldeprt(ix,jx) )
  90             this%soldeprt = 0.0
  91         else
  92             allocation_error = .true.
  93         end if
  94
  95         !allocate storage for sldpth
  96         if ( .not. allocated(this%sldpth) ) then
  97             allocate( this%sldpth(nsoil) )
  98             this%sldpth = 0.0
  99         else
 100             allocation_error = .true.
 101         endif
 102
 103         this%zsoil = 0.0
 104
 105         ! now initalize the shared properties from overland data
 106
 107         if ( associated(overland_data%properties%surface_slope_x) ) then
 108             this%surface_slope_x => overland_data%properties%surface_slope_x
 109         else
 110             allocation_error = .true.
 111         end if
 112
 113         if ( associated(overland_data%properties%surface_slope_y) ) then
 114             this%surface_slope_y => overland_data%properties%surface_slope_y
 115         else
 116             allocation_error = .true.
 117         end if
 118
 119         if ( associated(overland_data%properties%surface_slope) ) then
 120             this%surface_slope => overland_data%properties%surface_slope
 121         else
 122             allocation_error = .true.
 123         end if
 124
 125         if ( associated(overland_data%properties%max_surface_slope_index) ) then
 126             this%max_surface_slope_index => overland_data%properties%max_surface_slope_index
 127         else
 128             allocation_error = .true.
 129         end if
 130
 131         if ( associated(overland_data%properties%distance_to_neighbor) ) then
 132             this%distance_to_neighbor => overland_data%properties%distance_to_neighbor
 133         else
 134             allocation_error = .true.
 135         end if
 136
 137         ! allocate the array only if not already allocated
 138         if ( .not. allocated(this%nexprt) ) then
 139             allocate( this%nexprt(ix,jx) )
 140             this%nexprt = 1.0
 141         else
 142             allocation_error = .true.
 143         end if
 144
 145         if ( allocation_error ) &
 146             write(0,*) "attempt to allocate data in members of subsurface properties structure&
 147             &that where already allocated. The allocated members where not changed"
 148
 149     end subroutine subsurface_properties_init
 150
 151     subroutine subsurface_properties_destroy(this)
 152         implicit none
 153         class(subsurface_properties_interface), intent(inout) :: this ! the type object being destroyed
 154
 155         logical :: allocation_error = .false.
 156
 157         ! only deallocated if already allocated
 158         if ( allocated(this%lksatrt) ) then
 159             deallocate( this%lksatrt)
 160         else
 161             allocation_error = .true.
 162         end if
 163
 164         ! only deallocated if already allocated
 165         if ( allocated(this%zwattablrt) ) then
 166             deallocate( this%zwattablrt)
 167         else
 168             allocation_error = .true.
 169         end if
 170
 171         ! only deallocated if already allocated
 172         if ( allocated(this%soldeprt) ) then
 173             deallocate( this%soldeprt)
 174         else
 175             allocation_error = .true.
 176         end if
 177
 178         ! only deallocated if already allocated
 179         if ( allocated(this%sldpth) ) then
 180             deallocate( this%sldpth)
 181         else
 182             allocation_error = .true.
 183         end if
 184
 185
 186         ! now release the shared properties from overland data
 187
 188         if ( associated(this%surface_slope_x) ) then
 189             this%surface_slope_x => null()
 190         else
 191             allocation_error = .true.
 192         end if
 193
 194         if ( associated(this%surface_slope_y) ) then
 195             this%surface_slope_y => null()
 196         else
 197             allocation_error = .true.
 198         end if
 199
 200         if ( associated(this%surface_slope) ) then
 201             this%surface_slope => null()
 202         else
 203             allocation_error = .true.
 204         end if
 205
 206         if ( associated(this%max_surface_slope_index) ) then
 207             this%max_surface_slope_index => null()
 208         else
 209             allocation_error = .true.
 210         end if
 211
 212         if ( associated(this%distance_to_neighbor) ) then
 213             this%distance_to_neighbor => null()
 214         else
 215             allocation_error = .true.
 216         end if
 217
 218         ! only deallocated if already allocated
 219         if ( allocated(this%nexprt) ) then
 220             deallocate( this%nexprt)
 221         else
 222             allocation_error = .true.
 223         end if
 224
 225         if ( allocation_error ) &
 226             write(0,*) "attempt to deallocate data in members of subsurface properties structure&
 227             &that where not allocated. The unallocated members where not changed"
 228
 229     end subroutine subsurface_properties_destroy
 230
 231 end module module_subsurface_properties