hydro/Routing/Subsurface/module_subsurface_state.F

   1 module module_subsurface_state
   2     implicit none
   3
   4     type subsurface_state_interface
   5         ! total flow from boundary cells to outside of domain; on routing grid
   6         real :: qsubbdrytrt
   7
   8         ! subsurface flow (m^3/s)
   9         real, allocatable, dimension(:,:) :: qsubrt
  10
  11         ! flow from boundary cells to outside of domain on routing grid
  12         real, allocatable, dimension(:,:) :: qsubbdryrt
  13     contains
  14         procedure :: init => subsurface_state_init
  15         procedure :: destroy => subsurface_state_destroy
  16     end type subsurface_state_interface
  17
  18     contains
  19
  20     subroutine subsurface_state_init(this, ix, jx)
  21         implicit none
  22         class(subsurface_state_interface), intent(inout) :: this ! the type object being initialized
  23         integer, intent(in) :: ix                     ! x grid size
  24         integer, intent(in) :: jx                     ! y grid size
  25
  26         logical :: allocation_error = .false.
  27
  28         this%qsubbdrytrt = 0.0
  29
  30         if ( .not. allocated(this%qsubrt) ) then
  31             allocate( this%qsubrt(ix,jx) )
  32             this%qsubrt = 0.0
  33         else
  34             allocation_error = .true.
  35         end if
  36
  37         if ( .not. allocated(this%qsubbdryrt) ) then
  38             allocate( this%qsubbdryrt(ix,jx) )
  39             this%qsubbdryrt = 0.0
  40         else
  41             allocation_error = .true.
  42         end if
  43
  44         if ( allocation_error ) &
  45             write(0,*) "attempt to allocate data in members of subsurface io structure&
  46             &that where already allocated. The allocated members where not changed"
  47
  48     end subroutine subsurface_state_init
  49
  50     subroutine subsurface_state_destroy(this)
  51         implicit none
  52         class(subsurface_state_interface), intent(inout) :: this ! the type object being initialized
  53
  54         logical :: allocation_error = .false.
  55
  56         if ( allocated(this%qsubrt) ) then
  57             deallocate( this%qsubrt )
  58         else
  59             allocation_error = .true.
  60         end if
  61
  62         if ( allocated(this%qsubbdryrt) ) then
  63             deallocate( this%qsubbdryrt )
  64         else
  65             allocation_error = .true.
  66         end if
  67
  68         if ( allocation_error ) &
  69             write(0,*) "attempt to deallocate data in members of subsurface io structure&
  70             &that where not allocated. The unallocated members where not changed"
  71
  72     end subroutine subsurface_state_destroy
  73
  74 end module module_subsurface_state