hydro/Routing/Overland/module_overland_streams_and_lakes.F

   1 ! module overland_stream_and_lake_interface_data.F
   2 ! Purpose: This module contains the overland_control_struct class. This types holds
   3 ! the lakes and stream related 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_stream_and_lake_interface
   9     implicit none
  10
  11     ! type that hold inputs and outputs for stream and channels as well as
  12     ! variables used to interface with channels and lakes
  13     type overland_stream_and_lake_interface_struct
  14         !real :: qstrmvoltrt     ! total of qstrmvolrt
  15         !Accumulated water contribution form surface cells to channel cells throughout the simulation (mm)
  16         real :: accumulated_surface_water_to_channel
  17          !FIXME maybe move ^^^ to mass balance
  18
  19         !real :: lake_inflotrt   ! lake inflow from surface head
  20         !Accumulated water contribution from surface cells to lake cells throught the simulation (mm)
  21         real :: accumulated_surface_water_to_lake
  22         !FIXME maybe move ^^^ to mass balance
  23
  24         integer, allocatable, dimension(:,:) :: ch_netrt      ! keeps trake of the 0-1 channel network
  25         !Mask of the grid cells to indicate which cells are part of the channel network, 1 for channel, 0 for not
  26         !If the mask value is negative on gridded channel routing, then no channel routing occurs for that cell
  27         integer, allocatable, dimension(:,:) :: channel_mask
  28
  29         !integer, allocatable, dimension(:,:) :: lake_mskrt ! mask for identifing lake elements in channel network
  30         !Mask for the grid cells to indicate which cells are part of lakes, 0 for no lake
  31         !other values range from 1-N, indicating the index to the lake objects represented by the cells with the
  32         !same values (i.e, all lask_mask cells with a value of 1 make up the gridded representation of lake object 1)
  33         integer, allocatable, dimension(:,:) :: lake_mask
  34
  35         !real, allocatable, dimension(:,:) :: qstrmvolrt     ! accumulated channel inflow
  36         !Depth of water on the surface cell that will go into a channel cell from overland routing, depth (mm)
  37         real, allocatable, dimension(:,:) :: surface_water_to_channel
  38
  39
  40         !real, allocatable, dimension(:,:) :: lake_inflort   ! NEED VARIABLE INFO
  41         !Depth of water on the surface cell that will go into a lake cell from overland routing, depth (mm)
  42         real, allocatable, dimension(:,:) :: surface_water_to_lake
  43     contains
  44         procedure :: init => overland_stream_and_lake_interface_init
  45         procedure :: destroy => overland_stream_and_lake_interface_destroy
  46     end type overland_stream_and_lake_interface_struct
  47
  48     contains
  49
  50 ! this structure allocates and initalizes the members of an overland_stream_and_lake_interface strucutre
  51 ! if members have allready been initalized they will not be altered and an error will be logged
  52
  53 subroutine overland_stream_and_lake_interface_init(this,ix,jx)
  54     implicit none
  55     class(overland_stream_and_lake_interface_struct), intent(inout) :: this ! the type object being initalized
  56     integer, intent(in) :: ix                     ! x grid size
  57     integer, intent(in) :: jx                     ! y grid size
  58
  59     logical :: allocation_error = .false.
  60
  61     this%accumulated_surface_water_to_channel = 0.0
  62     this%accumulated_surface_water_to_lake = 0.0
  63
  64     ! allocate the stream network
  65     if ( .not. allocated(this%ch_netrt) ) then
  66         allocate( this%ch_netrt(ix,jx) )
  67         this%ch_netrt = 0.0
  68     else
  69         allocation_error = .true.
  70     end if
  71
  72     ! allocate the lake mask
  73     if ( .not. allocated(this%lake_mask) ) then
  74         allocate( this%lake_mask(ix,jx) )
  75         this%lake_mask = -9999
  76     else
  77         allocation_error = .true.
  78     end if
  79
  80     ! allocate qstrmvolrt
  81     if ( .not. allocated(this%surface_water_to_channel) ) then
  82         allocate( this%surface_water_to_channel(ix,jx) )
  83         this%surface_water_to_channel = 0.0
  84     else
  85         allocation_error = .true.
  86     end if
  87
  88     ! allocate lake_inflort
  89     if ( .not. allocated(this%surface_water_to_lake) ) then
  90         allocate( this%surface_water_to_lake(ix,jx) )
  91         this%surface_water_to_lake = 0.0
  92     else
  93         allocation_error = .true.
  94     end if
  95
  96     if ( allocation_error ) &
  97         write(0,*) "attempt to allocate data in members of overland lakes and streams structure&
  98         &that where allready allocated. The allocated members where not changed"
  99 end subroutine overland_stream_and_lake_interface_init
 100
 101 ! this procedure deallocates and overland_stream_and_lake_interface structure that was initalized with
 102 ! overland_stream_and_lake_interface_init
 103
 104 subroutine overland_stream_and_lake_interface_destroy(this)
 105     implicit none
 106     class(overland_stream_and_lake_interface_struct), intent(inout) :: this ! the type object being destroyed
 107
 108     logical :: allocation_error = .false.
 109
 110     ! deallocate channel network
 111     if ( allocated(this%ch_netrt) ) then
 112         deallocate( this%ch_netrt )
 113     else
 114         allocation_error = .true.
 115     end if
 116
 117     ! deallocate the lake mask
 118     if ( allocated(this%lake_mask) ) then
 119         deallocate( this%lake_mask)
 120     else
 121         allocation_error = .true.
 122     end if
 123
 124     ! deallocate qstrmvolrt
 125     if ( allocated(this%surface_water_to_channel) ) then
 126          deallocate( this%surface_water_to_channel )
 127     else
 128         allocation_error = .true.
 129     end if
 130
 131     ! deallocate qbdryrt
 132     if ( allocated(this%surface_water_to_lake) ) then
 133          deallocate( this%surface_water_to_lake )          ! allocate qbdryrt
 134     else
 135         allocation_error = .true.
 136     end if
 137
 138     if ( allocation_error ) &
 139         write(0,*) "attempt to deallocate data in members of overland streams and lakes structure&
 140         &that where not allready allocated. The unallocated members where not changed"
 141 end subroutine overland_stream_and_lake_interface_destroy
 142
 143 end module overland_stream_and_lake_interface