Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / hydro / Routing / Subsurface / module_subsurface.F90
blob94b514483ab3c8f74f4977e24ffd4d4dbcc79a81
1 module module_subsurface_data
3     use module_subsurface_state
4     use module_subsurface_properties
5     use module_subsurface_grid_transform
7     ! included to allow properties to be shared between overland and subsurface code
8     use overland_data
10     implicit none
12     type subsurface_struct
14         type ( subsurface_state_interface), pointer :: state => null()
15         type ( subsurface_properties_interface), pointer :: properties => null()
16         type ( subsurface_grid_transform_interface), pointer :: grid_transform => null()
18         ! unused pointer are in an undefined state
19         ! this means the result of calling associated(<pointer>)
20         ! on a pointer that has not been set is unknown
21         ! therefore associated can not be used as a guard
22         ! in inital pointer allocation
23         logical, private :: pointer_allocation_guard = .false.
25         contains
27         procedure :: init => subsurface_struct_init
28         procedure :: destroy => subsurface_struct_destroy
30     end type subsurface_struct
32     contains
34     subroutine subsurface_struct_init(this,ix,jx,nsoil,overland_data)
35         implicit none
36         class(subsurface_struct), intent(inout) :: this ! the type object being initialized
37         integer, intent(in) :: ix                     ! x grid size
38         integer, intent(in) :: jx                     ! y grid size
39         integer, intent(in) :: nsoil                  ! number of soil layers
40         type(overland_struct), intent(inout) :: overland_data        ! overland data strucuture
42     if (this%pointer_allocation_guard .eqv. .false. ) then
43         this%pointer_allocation_guard = .true.
44         ! allocate the io interface
45         allocate( this%state )
46         if ( .not. associated( this%state) ) then
47             write(0,*) "Failure to allocate subsurface io interface"
48         else
49             !write(0,*) "Allocating io structure"
50             call this%state%init(ix,jx)
51         end if
53         ! allocate the properties interface
54         allocate( this%properties )
55         if ( .not. associated( this%properties) ) then
56             write(0,*) "Failure to allocate subsurface io interface"
57         else
58             !write(0,*) "Allocating properties structure"
59             call this%properties%init(ix,jx,nsoil,overland_data)
60         end if
62         ! allocate the grid_transfrom interface
63         allocate( this%grid_transform )
64         if ( .not. associated( this%grid_transform) ) then
65             write(0,*) "Failure to allocate grid transform interface"
66         else
67             !write(0,*) "Allocating grid transform structure"
68             call this%grid_transform%init(ix,jx,nsoil)
69         end if
70     else
71         write(0,*)  "Attempt to double allocate subsurface_struct"
72     end if
74     end subroutine subsurface_struct_init
76     subroutine subsurface_struct_destroy(this)
77         implicit none
78         class(subsurface_struct), intent(inout) :: this ! the type object being initialized
80         if ( this%pointer_allocation_guard .eqv. .true.) then
81             !write(0,*) "Testing pointers for deallocation"
82             if ( associated( this%state ) ) then
83                 call this%state%destroy
84                 deallocate( this%state )
85             end if
87             if (associated( this%properties ) )then
88                 call this%properties%destroy
89                 deallocate( this%properties )
90             end if
92             if (associated( this%grid_transform ) ) then
93                 call this%grid_transform%destroy
94                 deallocate( this%grid_transform )
95             end if
97             this%pointer_allocation_guard = .false.
98         else
99             write(0,*)  "Attempt to double delete subsurface_struct"
100         end if
102     end subroutine subsurface_struct_destroy
104 end module module_subsurface_data