MODFLOW 6  version 6.7.0.dev3
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(virtualinttype), pointer :: fmi_igwfspdis => null()
25  type(virtualdbl1dtype), pointer :: fmi_gwfhead => null()
26  type(virtualdbl1dtype), pointer :: fmi_gwfsat => null()
27  type(virtualdbl2dtype), pointer :: fmi_gwfspdis => null()
28  type(virtualdbl1dtype), pointer :: fmi_gwfflowja => null()
29  ! MST
30  type(virtualdbl1dtype), pointer :: mst_thetam => null()
31  ! GWT Model fields
32  type(virtualinttype), pointer :: indsp => null()
33  type(virtualinttype), pointer :: inmst => null()
34  contains
35  ! public
36  procedure :: create => vgwt_create
37  procedure :: prepare_stage => vgwt_prepare_stage
38  procedure :: destroy => vgwt_destroy
39  ! private
40  procedure, private :: init_virtual_data
41  procedure, private :: allocate_data
42  procedure, private :: deallocate_data
43  end type virtualgwtmodeltype
44 
45 contains
46 
47  subroutine add_virtual_gwt_model(model_id, model_name, model)
48  use virtualdatalistsmodule, only: virtual_model_list
49  integer(I4B) :: model_id !< global model id
50  character(len=*) :: model_name !< model name
51  class(numericalmodeltype), pointer :: model !< the actual model (can be null() when remote)
52  ! local
53  class(virtualgwtmodeltype), pointer :: virtual_gwt_model
54  class(*), pointer :: obj
55 
56  allocate (virtual_gwt_model)
57  call virtual_gwt_model%create(model_name, model_id, model)
58 
59  obj => virtual_gwt_model
60  call virtual_model_list%Add(obj)
61 
62  end subroutine add_virtual_gwt_model
63 
64  subroutine vgwt_create(this, name, id, model)
65  class(virtualgwtmodeltype) :: this
66  character(len=*) :: name
67  integer(I4B) :: id
68  class(numericalmodeltype), pointer :: model
69 
70  ! create base
71  call this%VirtualModelType%create(name, id, model)
72  this%container_type = vdc_gwtmodel_type
73 
74  call this%allocate_data()
75  call this%init_virtual_data()
76 
77  end subroutine vgwt_create
78 
79  subroutine init_virtual_data(this)
80  class(virtualgwtmodeltype) :: this
81 
82  call this%set(this%dsp_idiffc%base(), 'IDIFFC', 'DSP', map_all_type)
83  call this%set(this%dsp_idisp%base(), 'IDISP', 'DSP', map_all_type)
84  call this%set(this%dsp_diffc%base(), 'DIFFC', 'DSP', map_node_type)
85  call this%set(this%dsp_alh%base(), 'ALH', 'DSP', map_node_type)
86  call this%set(this%dsp_alv%base(), 'ALV', 'DSP', map_node_type)
87  call this%set(this%dsp_ath1%base(), 'ATH1', 'DSP', map_node_type)
88  call this%set(this%dsp_ath2%base(), 'ATH2', 'DSP', map_node_type)
89  call this%set(this%dsp_atv%base(), 'ATV', 'DSP', map_node_type)
90  call this%set(this%fmi_igwfspdis%base(), 'IGWFSPDIS', 'FMI', map_all_type)
91  call this%set(this%fmi_gwfhead%base(), 'GWFHEAD', 'FMI', map_node_type)
92  call this%set(this%fmi_gwfsat%base(), 'GWFSAT', 'FMI', map_node_type)
93  call this%set(this%fmi_gwfspdis%base(), 'GWFSPDIS', 'FMI', map_node_type)
94  call this%set(this%fmi_gwfflowja%base(), 'GWFFLOWJA', 'FMI', map_conn_type)
95  call this%set(this%mst_thetam%base(), 'THETAM', 'MST', map_node_type)
96  call this%set(this%indsp%base(), 'INDSP', '', map_all_type)
97  call this%set(this%inmst%base(), 'INMST', '', map_all_type)
98 
99  end subroutine init_virtual_data
100 
101  subroutine vgwt_prepare_stage(this, stage)
102  class(virtualgwtmodeltype) :: this
103  integer(I4B) :: stage
104  ! local
105  integer(I4B) :: nr_nodes, nr_conns
106 
107  ! prepare base (=numerical) model data items
108  call this%VirtualModelType%prepare_stage(stage)
109 
110  nr_nodes = 0
111  nr_conns = 0
112 
113  if (stage == stg_aft_mdl_df) then
114 
115  call this%map(this%dsp_idiffc%base(), (/stg_aft_mdl_df/))
116  call this%map(this%dsp_idisp%base(), (/stg_aft_mdl_df/))
117  call this%map(this%indsp%base(), (/stg_aft_mdl_df/))
118  call this%map(this%inmst%base(), (/stg_aft_mdl_df/))
119 
120  else if (stage == stg_bfr_con_ar) then
121 
122  nr_nodes = this%element_maps(map_node_type)%nr_virt_elems
123  nr_conns = this%element_maps(map_conn_type)%nr_virt_elems
124 
125  call this%map(this%fmi_igwfspdis%base(), (/stg_bfr_con_ar/))
126  call this%map(this%x%base(), nr_nodes, &
127  (/stg_bfr_con_ar, stg_bfr_exg_ad, stg_bfr_exg_cf/))
128  call this%map(this%ibound%base(), nr_nodes, (/stg_bfr_con_ar/))
129 
130  if (this%dsp_idiffc%get() > 0) then
131  call this%map(this%dsp_diffc%base(), nr_nodes, (/stg_bfr_con_ar/))
132  end if
133 
134  if (this%dsp_idisp%get() > 0) then
135  call this%map(this%dsp_alh%base(), nr_nodes, (/stg_bfr_con_ar/))
136  call this%map(this%dsp_alv%base(), nr_nodes, (/stg_bfr_con_ar/))
137  call this%map(this%dsp_ath1%base(), nr_nodes, (/stg_bfr_con_ar/))
138  call this%map(this%dsp_ath2%base(), nr_nodes, (/stg_bfr_con_ar/))
139  call this%map(this%dsp_atv%base(), nr_nodes, (/stg_bfr_con_ar/))
140  end if
141 
142  if (this%indsp%get() > 0 .and. this%inmst%get() > 0) then
143  call this%map(this%mst_thetam%base(), nr_nodes, (/stg_aft_con_ar/))
144  end if
145 
146  else if (stage == stg_aft_con_ar) then
147 
148  nr_nodes = this%element_maps(map_node_type)%nr_virt_elems
149  nr_conns = this%element_maps(map_conn_type)%nr_virt_elems
150 
151  call this%map(this%fmi_gwfhead%base(), nr_nodes, (/stg_bfr_exg_ad/))
152  call this%map(this%fmi_gwfsat%base(), nr_nodes, (/stg_bfr_exg_ad/))
153  if (this%fmi_igwfspdis%get() > 0) then
154  call this%map(this%fmi_gwfspdis%base(), 3, nr_nodes, (/stg_bfr_exg_ad/))
155  else
156  call this%map(this%fmi_gwfspdis%base(), 3, 0, (/stg_never/))
157  end if
158  call this%map(this%fmi_gwfflowja%base(), nr_conns, (/stg_bfr_exg_ad/))
159 
160  end if
161 
162  end subroutine vgwt_prepare_stage
163 
164  subroutine allocate_data(this)
165  class(virtualgwtmodeltype) :: this
166 
167  allocate (this%dsp_idiffc)
168  allocate (this%dsp_idisp)
169  allocate (this%dsp_diffc)
170  allocate (this%dsp_alh)
171  allocate (this%dsp_alv)
172  allocate (this%dsp_ath1)
173  allocate (this%dsp_ath2)
174  allocate (this%dsp_atv)
175  allocate (this%fmi_igwfspdis)
176  allocate (this%fmi_gwfhead)
177  allocate (this%fmi_gwfsat)
178  allocate (this%fmi_gwfspdis)
179  allocate (this%fmi_gwfflowja)
180  allocate (this%mst_thetam)
181  allocate (this%indsp)
182  allocate (this%inmst)
183 
184  end subroutine allocate_data
185 
186  subroutine deallocate_data(this)
187  class(virtualgwtmodeltype) :: this
188 
189  deallocate (this%dsp_idiffc)
190  deallocate (this%dsp_idisp)
191  deallocate (this%dsp_diffc)
192  deallocate (this%dsp_alh)
193  deallocate (this%dsp_alv)
194  deallocate (this%dsp_ath1)
195  deallocate (this%dsp_ath2)
196  deallocate (this%dsp_atv)
197  deallocate (this%fmi_igwfspdis)
198  deallocate (this%fmi_gwfhead)
199  deallocate (this%fmi_gwfsat)
200  deallocate (this%fmi_gwfspdis)
201  deallocate (this%fmi_gwfflowja)
202  deallocate (this%mst_thetam)
203  deallocate (this%indsp)
204  deallocate (this%inmst)
205 
206  end subroutine deallocate_data
207 
208  subroutine vgwt_destroy(this)
209  class(virtualgwtmodeltype) :: this
210 
211  call this%VirtualModelType%destroy()
212  call this%deallocate_data()
213 
214  end subroutine vgwt_destroy
215 
216 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_never
integer(i4b), parameter, public stg_never
never
Definition: SimStages.f90:9
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:65
virtualgwtmodelmodule::deallocate_data
subroutine deallocate_data(this)
Definition: VirtualGwtModel.f90:187
virtualgwtmodelmodule::add_virtual_gwt_model
subroutine, public add_virtual_gwt_model(model_id, model_name, model)
Definition: VirtualGwtModel.f90:48
virtualgwtmodelmodule::vgwt_prepare_stage
subroutine vgwt_prepare_stage(this, stage)
Definition: VirtualGwtModel.f90:102
virtualgwtmodelmodule::vgwt_destroy
subroutine vgwt_destroy(this)
Definition: VirtualGwtModel.f90:209
virtualgwtmodelmodule::allocate_data
subroutine allocate_data(this)
Definition: VirtualGwtModel.f90:165
virtualgwtmodelmodule::init_virtual_data
subroutine init_virtual_data(this)
Definition: VirtualGwtModel.f90:80