hydro/Routing/Overland/module_overland_routing_properties.F

   1 ! module overland_routing_properties_data.F
   2 ! Purpose: This module contains the overland_control_struct class. This types holds
   3 ! the physical property 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_routing_properties
   9     implicit none
  10
  11    ! holds proprties of the the routing grid needed by overland routing algs
  12    type overland_routing_properties_struct
  13       integer :: ixrt                                            ! number of cells in x direction on the routing grid
  14       integer :: jxrt                                            ! number of cells in y direction on the routing grid
  15
  16       ! PROPOSED a more logical representation of the grid that is relative to the module would be nice.
  17       ! Currently, we are leaving the legacy ixrt/jxrt names to simplify the interaction of these variables in other places in the code.
  18       ! At the very least, we need to drop the rt quantifier when we can, since these are clearly ix/jx in the overland_routing structure
  19       ! Once the subsurface interface is identified, I think we should revisit these.  And if possible, get away from the x notation, a more clear
  20       ! name might be something like these:
  21       !integer :: rows                                           ! number of cells in x direction on the routing grid
  22       !integer :: columns                                        ! number of cells in y direction on the routing grid
  23
  24       ! replaced with surface_slope_x
  25       !real, allocatable, dimension(:,:) :: soxrt
  26       ! terrian slope in the x direction (m/m)
  27       real, pointer, dimension(:,:) :: surface_slope_x => null()
  28
  29       ! replaced with surface_slope_y
  30       !real, allocatable, dimension(:,:) :: soyrt
  31       ! terrian slope in the y direction (m/m)
  32       real, pointer, dimension(:,:) :: surface_slope_y => null()
  33
  34       ! reaplaced with roughness
  35       !real, allocatable, dimension(:,:) :: ovroughrt
  36       ! surface roughness parameter for Manning's equation; dissagregated from the land surface model, with adjustment factor applied (none)
  37       real, allocatable, dimension(:,:) :: roughness
  38
  39       ! replaced with retention_depth
  40       !real, allocatable, dimension(:,:) :: retdeprt
  41       ! minimum amount of surface water required before water is routed as overland flow (mm)
  42       real, allocatable, dimension(:,:) :: retention_depth
  43
  44       ! replaced with surface_slope
  45       !real, allocatable, dimension(:,:,:) :: so8rt
  46       ! terrain surface slope in 8 ordinal directions (m/m)                                                                  !
  47       ! TODO verify this correct, check with Wei?
  48       !                      1
  49       !                      |
  50       !                  8       2
  51       !                    \   /
  52       !                 7__     __ 3
  53       !
  54       !                    /   \
  55       !                   6     4
  56       !                      |
  57       !                      5
  58       !
  59       real, pointer, dimension(:,:,:) :: surface_slope => null()
  60
  61       ! replaced with max_surface_slope_index
  62       !integer, allocatable, dimension(:,:,:) :: so8rt_d
  63       ! index of neighboring cell in the direction of steepest terrain surface slope, used with surface_slope
  64       integer, pointer, dimension(:,:,:) :: max_surface_slope_index => null()
  65
  66       ! replaced with distance_to_neighbor
  67       !real, allocatable, dimension(:,:,:) :: dist
  68       ! centerpoint distance to each neighbor (m)
  69       real, pointer, dimension(:,:,:) :: distance_to_neighbor => null()
  70       ! PROPOSED
  71       ! For a regular grid, distance_to_neighbor should be pretty static, right?
  72       ! neighbors 1,3,5,7 dist = grid_size
  73       ! neighbors 2,4,6,8 dist = sqrt( grid_size^2 + grid_size^2)
  74       ! would suggest eliminating this and using two static variables for square grids.
  75       ! i.e. direct_neighbor_distance = grid_size
  76       !      diagonal_neighbor_distance = sqrt( 2*(grid_size^2) )
  77
  78       contains
  79          procedure :: init => overland_properties_init
  80          procedure :: destroy => overland_properties_destory
  81    end type overland_routing_properties_struct
  82
  83    contains
  84
  85 ! this procedure allocates memory for an overland_routing_properties structure that has not been allocated
  86 ! if the structure has been allocated an error will be logged
  87
  88 subroutine overland_properties_init(this,ix,jx)
  89     implicit none
  90     class(overland_routing_properties_struct), intent(inout) :: this ! the type object being initalized
  91     integer, intent(in) :: ix                     ! x grid size
  92     integer, intent(in) :: jx                     ! y grid size
  93
  94     logical :: allocation_error = .false.
  95
  96     ! record the grid dimensions
  97     ! TODO find a better place for this to be stored
  98     this%ixrt = ix
  99     this%jxrt = jx
 100
 101     ! allocate x slope
 102     if ( .not. associated(this%surface_slope_x) ) then
 103         allocate( this%surface_slope_x(ix,jx) )
 104         this%surface_slope_x = 0.0
 105     else
 106         allocation_error = .true.
 107     end if
 108
 109     ! allocate y slope
 110     if ( .not. associated(this%surface_slope_y) ) then
 111         allocate( this%surface_slope_y(ix,jx) )
 112         this%surface_slope_y = 0.0
 113     else
 114         allocation_error = .true.
 115     end if
 116
 117     ! allocate 8 directional slope
 118     if ( .not. associated(this%surface_slope) ) then
 119         allocate( this%surface_slope(ix,jx,8) )
 120         this%surface_slope = -999
 121     else
 122         allocation_error = .true.
 123     end if
 124
 125     ! allocate slope index
 126     if ( .not. associated(this%max_surface_slope_index) ) then
 127         allocate( this%max_surface_slope_index(ix,jx,3) )
 128         this%max_surface_slope_index = 0.0
 129     else
 130         allocation_error = .true.
 131     end if
 132
 133     ! allocate surface roughness
 134     if ( .not. allocated(this%roughness) ) then
 135         allocate( this%roughness(ix,jx) )
 136         this%roughness = 0.0
 137     else
 138         allocation_error = .true.
 139     end if
 140
 141     ! allocate retention depth
 142     if ( .not. allocated(this%retention_depth) ) then
 143         allocate( this%retention_depth(ix,jx) )
 144         this%retention_depth = 0.001   ! units (mm)
 145     else
 146         allocation_error = .true.
 147     end if
 148
 149     ! allocate dist
 150     if ( .not. associated(this%distance_to_neighbor) ) then
 151         allocate( this%distance_to_neighbor(ix,jx,9) )
 152         this%distance_to_neighbor = -999
 153     else
 154         allocation_error = .true.
 155     end if
 156
 157     if ( allocation_error ) &
 158         write(0,*) "attempt to allocate data in members of overland properties structure&
 159         &that where allready allocated. The allocated members where not changed"
 160 end subroutine overland_properties_init
 161
 162 ! this procedure deallocates and overland_routing_properties structure that was initalized with
 163 ! overland_properties_init
 164
 165 subroutine overland_properties_destory(this)
 166     implicit none
 167     class(overland_routing_properties_struct), intent(inout) :: this ! the type object being destroyed
 168
 169     logical :: allocation_error = .false.
 170
 171     ! deallocate x slope
 172     if ( associated(this%surface_slope_x) ) then
 173         deallocate( this%surface_slope_x )
 174     else
 175         allocation_error = .true.
 176     end if
 177
 178     ! allocate y slope
 179     if ( associated(this%surface_slope_y) ) then
 180         deallocate( this%surface_slope_y )
 181     else
 182         allocation_error = .true.
 183     end if
 184
 185     ! allocate water surface slope
 186     if ( associated(this%surface_slope) ) then
 187         deallocate( this%surface_slope )
 188     else
 189         allocation_error = .true.
 190     end if
 191
 192     ! allocate slope index
 193     if ( associated(this%max_surface_slope_index) ) then
 194         deallocate( this%max_surface_slope_index )
 195     else
 196         allocation_error = .true.
 197     end if
 198
 199     ! allocate surface roughness
 200     if ( allocated(this%roughness) ) then
 201         deallocate( this%roughness )
 202     else
 203         allocation_error = .true.
 204     end if
 205
 206     ! allocate retention depth
 207     if ( allocated(this%retention_depth ) ) then
 208         deallocate( this%retention_depth )
 209     else
 210         allocation_error = .true.
 211     end if
 212
 213     ! allocate dist
 214     if ( associated(this%distance_to_neighbor) ) then
 215         deallocate( this%distance_to_neighbor )
 216     else
 217         allocation_error = .true.
 218     end if
 219
 220     if ( allocation_error ) &
 221         write(0,*) "attempt to deallocate data in members of overland properties structure&
 222         &that where not allocated. The unallocated members where not changed"
 223 end subroutine overland_properties_destory
 224
 225
 226 end module overland_routing_properties