MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
VirtualGwtModel.f90
Go to the documentation of this file.
1 module virtualgwtmodelmodule
2  use kindmodule, only: i4b
3  use simstagesmodule
4  use virtualbasemodule
5  use virtualdatacontainermodule, only: vdc_gwtmodel_type
6  use virtualmodelmodule
7  use numericalmodelmodule, only: numericalmodeltype
8  implicit none
9  private
10 
11  public :: add_virtual_gwt_model
12 
13  type, extends(virtualmodeltype) :: virtualgwtmodeltype
14  ! DSP
15  type(virtualinttype), pointer :: dsp_idiffc => null()
16  type(virtualinttype), pointer :: dsp_idisp => null()
17  type(virtualdbl1dtype), pointer :: dsp_diffc => null()
18  type(virtualdbl1dtype), pointer :: dsp_alh => null()
19  type(virtualdbl1dtype), pointer :: dsp_alv => null()
20  type(virtualdbl1dtype), pointer :: dsp_ath1 => null()
21  type(virtualdbl1dtype), pointer :: dsp_ath2 => null()
22  type(virtualdbl1dtype), pointer :: dsp_atv => null()
23  ! FMI
24  type(virtualdbl1dtype), pointer :: fmi_gwfhead => null()
25  type(virtualdbl1dtype), pointer :: fmi_gwfsat => null()
26  type(virtualdbl2dtype), pointer :: fmi_gwfspdis => null()
27  type(virtualdbl1dtype), pointer :: fmi_gwfflowja => null()
28  ! MST
29  type(virtualdbl1dtype), pointer :: mst_thetam => null()
30  ! GWT Model fields
31  type(virtualinttype), pointer :: indsp => null()
32  type(virtualinttype), pointer :: inmst => null()
33  contains
34  ! public
35  procedure :: create => vgwt_create
36  procedure :: prepare_stage => vgwt_prepare_stage
37  procedure :: destroy => vgwt_destroy
38  ! private
39  procedure, private :: init_virtual_data
40  procedure, private :: allocate_data
41  procedure, private :: deallocate_data
42  end type virtualgwtmodeltype
43 
44 contains
45 
46  subroutine add_virtual_gwt_model(model_id, model_name, model)
47  use virtualdatalistsmodule, only: virtual_model_list
48  integer(I4B) :: model_id !< global model id
49  character(len=*) :: model_name !< model name
50  class(numericalmodeltype), pointer :: model !< the actual model (can be null() when remote)
51  ! local
52  class(virtualgwtmodeltype), pointer :: virtual_gwt_model
53  class(*), pointer :: obj
54 
55  allocate (virtual_gwt_model)
56  call virtual_gwt_model%create(model_name, model_id, model)
57 
58  obj => virtual_gwt_model
59  call virtual_model_list%Add(obj)
60 
61  end subroutine add_virtual_gwt_model
62 
63  subroutine vgwt_create(this, name, id, model)
64  class(virtualgwtmodeltype) :: this
65  character(len=*) :: name
66  integer(I4B) :: id
67  class(numericalmodeltype), pointer :: model
68 
69  ! create base
70  call this%VirtualModelType%create(name, id, model)
71  this%container_type = vdc_gwtmodel_type
72 
73  call this%allocate_data()
74  call this%init_virtual_data()
75 
76  end subroutine vgwt_create
77 
78  subroutine init_virtual_data(this)
79  class(virtualgwtmodeltype) :: this
80 
81  call this%set(this%dsp_idiffc%base(), 'IDIFFC', 'DSP', map_all_type)
82  call this%set(this%dsp_idisp%base(), 'IDISP', 'DSP', map_all_type)
83  call this%set(this%dsp_diffc%base(), 'DIFFC', 'DSP', map_node_type)
84  call this%set(this%dsp_alh%base(), 'ALH', 'DSP', map_node_type)
85  call this%set(this%dsp_alv%base(), 'ALV', 'DSP', map_node_type)
86  call this%set(this%dsp_ath1%base(), 'ATH1', 'DSP', map_node_type)
87  call this%set(this%dsp_ath2%base(), 'ATH2', 'DSP', map_node_type)
88  call this%set(this%dsp_atv%base(), 'ATV', 'DSP', map_node_type)
89  call this%set(this%fmi_gwfhead%base(), 'GWFHEAD', 'FMI', map_node_type)
90  call this%set(this%fmi_gwfsat%base(), 'GWFSAT', 'FMI', map_node_type)
91  call this%set(this%fmi_gwfspdis%base(), 'GWFSPDIS', 'FMI', map_node_type)
92  call this%set(this%fmi_gwfflowja%base(), 'GWFFLOWJA', 'FMI', map_conn_type)
93  call this%set(this%mst_thetam%base(), 'THETAM', 'MST', map_node_type)
94  call this%set(this%indsp%base(), 'INDSP', '', map_all_type)
95  call this%set(this%inmst%base(), 'INMST', '', map_all_type)
96 
97  end subroutine init_virtual_data
98 
99  subroutine vgwt_prepare_stage(this, stage)
100  class(virtualgwtmodeltype) :: this
101  integer(I4B) :: stage
102  ! local
103  integer(I4B) :: nr_nodes, nr_conns
104 
105  ! prepare base (=numerical) model data items
106  call this%VirtualModelType%prepare_stage(stage)
107 
108  nr_nodes = 0
109  nr_conns = 0
110 
111  if (stage == stg_aft_mdl_df) then
112 
113  call this%map(this%dsp_idiffc%base(), (/stg_aft_mdl_df/))
114  call this%map(this%dsp_idisp%base(), (/stg_aft_mdl_df/))
115  call this%map(this%indsp%base(), (/stg_aft_mdl_df/))
116  call this%map(this%inmst%base(), (/stg_aft_mdl_df/))
117 
118  else if (stage == stg_bfr_con_ar) then
119 
120  nr_nodes = this%element_maps(map_node_type)%nr_virt_elems
121  nr_conns = this%element_maps(map_conn_type)%nr_virt_elems
122 
123  call this%map(this%x%base(), nr_nodes, &
124  (/stg_bfr_con_ar, stg_bfr_exg_ad, stg_bfr_exg_cf/))
125  call this%map(this%ibound%base(), nr_nodes, (/stg_bfr_con_ar/))
126 
127  if (this%dsp_idiffc%get() > 0) then
128  call this%map(this%dsp_diffc%base(), nr_nodes, (/stg_bfr_con_ar/))
129  end if
130 
131  if (this%dsp_idisp%get() > 0) then
132  call this%map(this%dsp_alh%base(), nr_nodes, (/stg_bfr_con_ar/))
133  call this%map(this%dsp_alv%base(), nr_nodes, (/stg_bfr_con_ar/))
134  call this%map(this%dsp_ath1%base(), nr_nodes, (/stg_bfr_con_ar/))
135  call this%map(this%dsp_ath2%base(), nr_nodes, (/stg_bfr_con_ar/))
136  call this%map(this%dsp_atv%base(), nr_nodes, (/stg_bfr_con_ar/))
137  end if
138 
139  call this%map(this%fmi_gwfhead%base(), nr_nodes, (/stg_bfr_exg_ad/))
140  call this%map(this%fmi_gwfsat%base(), nr_nodes, (/stg_bfr_exg_ad/))
141  call this%map(this%fmi_gwfspdis%base(), 3, nr_nodes, (/stg_bfr_exg_ad/))
142  call this%map(this%fmi_gwfflowja%base(), nr_conns, (/stg_bfr_exg_ad/))
143 
144  if (this%indsp%get() > 0 .and. this%inmst%get() > 0) then
145  call this%map(this%mst_thetam%base(), nr_nodes, (/stg_aft_con_ar/))
146  end if
147 
148  end if
149 
150  end subroutine vgwt_prepare_stage
151 
152  subroutine allocate_data(this)
153  class(virtualgwtmodeltype) :: this
154 
155  allocate (this%dsp_idiffc)
156  allocate (this%dsp_idisp)
157  allocate (this%dsp_diffc)
158  allocate (this%dsp_alh)
159  allocate (this%dsp_alv)
160  allocate (this%dsp_ath1)
161  allocate (this%dsp_ath2)
162  allocate (this%dsp_atv)
163  allocate (this%fmi_gwfhead)
164  allocate (this%fmi_gwfsat)
165  allocate (this%fmi_gwfspdis)
166  allocate (this%fmi_gwfflowja)
167  allocate (this%mst_thetam)
168  allocate (this%indsp)
169  allocate (this%inmst)
170 
171  end subroutine allocate_data
172 
173  subroutine deallocate_data(this)
174  class(virtualgwtmodeltype) :: this
175 
176  deallocate (this%dsp_idiffc)
177  deallocate (this%dsp_idisp)
178  deallocate (this%dsp_diffc)
179  deallocate (this%dsp_alh)
180  deallocate (this%dsp_alv)
181  deallocate (this%dsp_ath1)
182  deallocate (this%dsp_ath2)
183  deallocate (this%dsp_atv)
184  deallocate (this%fmi_gwfhead)
185  deallocate (this%fmi_gwfsat)
186  deallocate (this%fmi_gwfspdis)
187  deallocate (this%fmi_gwfflowja)
188  deallocate (this%mst_thetam)
189  deallocate (this%indsp)
190  deallocate (this%inmst)
191 
192  end subroutine deallocate_data
193 
194  subroutine vgwt_destroy(this)
195  class(virtualgwtmodeltype) :: this
196 
197  call this%VirtualModelType%destroy()
198  call this%deallocate_data()
199 
200  end subroutine vgwt_destroy
201 
202 end module virtualgwtmodelmodule
kindmodule
This module defines variable data types.
Definition: kind.f90:8
simstagesmodule::stg_aft_con_ar
integer(i4b), parameter, public stg_aft_con_ar
afterr connection allocate read
Definition: SimStages.f90:18
simstagesmodule::stg_aft_mdl_df
integer(i4b), parameter, public stg_aft_mdl_df
after model define
Definition: SimStages.f90:11
simstagesmodule::stg_bfr_exg_ad
integer(i4b), parameter, public stg_bfr_exg_ad
before exchange advance (per solution)
Definition: SimStages.f90:21
simstagesmodule::stg_bfr_exg_cf
integer(i4b), parameter, public stg_bfr_exg_cf
before exchange calculate (per solution)
Definition: SimStages.f90:22
simstagesmodule::stg_bfr_con_ar
integer(i4b), parameter, public stg_bfr_con_ar
before connection allocate read
Definition: SimStages.f90:17
virtualbasemodule::map_conn_type
integer(i4b), parameter, public map_conn_type
Definition: VirtualBase.f90:15
virtualbasemodule::map_all_type
integer(i4b), parameter, public map_all_type
Definition: VirtualBase.f90:13
virtualbasemodule::map_node_type
integer(i4b), parameter, public map_node_type
Definition: VirtualBase.f90:14
virtualdatacontainermodule::vdc_gwtmodel_type
integer(i4b), parameter, public vdc_gwtmodel_type
Definition: VirtualDataContainer.f90:18
virtualdatalistsmodule::virtual_model_list
type(listtype), public virtual_model_list
Definition: VirtualDataLists.f90:9
virtualgwtmodelmodule::vgwt_create
subroutine vgwt_create(this, name, id, model)
Definition: VirtualGwtModel.f90:64
virtualgwtmodelmodule::deallocate_data
subroutine deallocate_data(this)
Definition: VirtualGwtModel.f90:174
virtualgwtmodelmodule::add_virtual_gwt_model
subroutine, public add_virtual_gwt_model(model_id, model_name, model)
Definition: VirtualGwtModel.f90:47
virtualgwtmodelmodule::vgwt_prepare_stage
subroutine vgwt_prepare_stage(this, stage)
Definition: VirtualGwtModel.f90:100
virtualgwtmodelmodule::vgwt_destroy
subroutine vgwt_destroy(this)
Definition: VirtualGwtModel.f90:195
virtualgwtmodelmodule::allocate_data
subroutine allocate_data(this)
Definition: VirtualGwtModel.f90:153
virtualgwtmodelmodule::init_virtual_data
subroutine init_virtual_data(this)
Definition: VirtualGwtModel.f90:79