hydro/Routing/Subsurface/module_subsurface_grid_transform.F

   1 module module_subsurface_grid_transform
   2     implicit none
   3
   4     type subsurface_grid_transform_interface
   5
   6         ! temp array? field capacity disaggregated to routing grid, for each soil layer
   7         real, allocatable, dimension(:,:,:) :: smcrefrt
   8
   9         ! Soil Moisture Content -- ???
  10         real, allocatable, dimension(:,:,:) :: smcrt
  11
  12         ! Soil Moisture Content -- ??? Porosity
  13         real, allocatable, dimension(:,:,:) :: smcmaxrt
  14
  15         ! Soil Moisture Content -- ??? Wilting Point
  16         real, allocatable, dimension(:,:,:) :: smcwltrt
  17     contains
  18         procedure :: init => subsurface_grid_transform_init
  19         procedure :: destroy => subsurface_grid_transfrom_destroy
  20     end type
  21
  22     contains
  23
  24     subroutine subsurface_grid_transform_init(this,ix,jx,nsoil)
  25         implicit none
  26         class(subsurface_grid_transform_interface), intent(inout) :: this ! the type object being initialized
  27         integer, intent(in) :: ix                     ! x grid size
  28         integer, intent(in) :: jx                     ! y grid size
  29         integer, intent(in) :: nsoil                  ! number of soil layers
  30
  31         logical :: allocation_error = .false.
  32
  33         ! check allocation status of smcrefrt
  34         if ( .not. allocated(this%smcrefrt) ) then
  35             allocate( this%smcrefrt(ix,jx,nsoil) )
  36             !no initialization on this variable?
  37             !this%smcrefrt = 0.0
  38         else
  39             allocation_error = .true.
  40         end if
  41
  42         ! check to see if smcrt is allocated
  43         if ( .not. allocated(this%smcrt) ) then
  44             allocate( this%smcrt(ix,jx,nsoil) )
  45             this%smcrt = 0.0
  46         else
  47             allocation_error = .true.
  48         end if
  49
  50         ! check to see if smcmaxrt is allocated
  51         if ( .not. allocated(this%smcmaxrt) ) then
  52             allocate( this%smcmaxrt(ix,jx,nsoil) )
  53             this%smcmaxrt = 0.0
  54         end if
  55
  56         ! check to see if smcwltrt is allocated
  57         if ( .not. allocated(this%smcwltrt) ) then
  58             allocate( this%smcwltrt(ix,jx,nsoil) )
  59             this%smcwltrt = 0.0
  60         else
  61             allocation_error = .true.
  62         end if
  63
  64         if ( allocation_error ) &
  65             write(0,*) "attempt to allocate data in members of subsurface grid transform structure&
  66             &that where already allocated. The allocated members where not changed"
  67
  68     end subroutine subsurface_grid_transform_init
  69
  70     subroutine subsurface_grid_transfrom_destroy(this)
  71         implicit none
  72         class(subsurface_grid_transform_interface), intent(inout) :: this ! the type object being initialized
  73
  74         logical :: allocation_error = .false.
  75
  76         ! check allocation status of smcrefrt
  77         if ( allocated(this%smcrefrt) ) then
  78             deallocate( this%smcrefrt )
  79         else
  80             allocation_error = .true.
  81         end if
  82
  83         ! check to see if smcrt is allocated
  84         if ( allocated(this%smcrt) ) then
  85             deallocate( this%smcrt )
  86         else
  87             allocation_error = .true.
  88         end if
  89
  90         ! check to see if smcmaxrt is allocated
  91         if ( allocated(this%smcmaxrt) ) then
  92             deallocate( this%smcmaxrt )
  93         else
  94             allocation_error = .true.
  95         end if
  96
  97         ! check to see if smcwltrt is allocated
  98         if ( allocated(this%smcwltrt) ) then
  99             deallocate( this%smcwltrt )
 100         else
 101             allocation_error = .true.
 102         end if
 103
 104         if ( allocation_error ) &
 105             write(0,*) "attempt to deallocate data in members of subsurface grid transform structure&
 106             &that where not allocated. The unallocated members where not changed"
 107
 108     end subroutine
 109
 110 end module module_subsurface_grid_transform