MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
InputLoadType.f90
Go to the documentation of this file.
1 !> @brief This module contains the InputLoadTypeModule
2 !!
3 !! This module defines types that support generic IDM
4 !! static and dynamic input loading.
5 !!
6 !<
8 
9  use kindmodule, only: dp, i4b, lgp
12  use simvariablesmodule, only: errmsg
15  use listmodule, only: listtype
18 
19  implicit none
20  private
21  public :: staticpkgloadbasetype
22  public :: dynamicpkgloadbasetype
23  public :: modeldynamicpkgstype
26  public :: model_dynamic_pkgs
27 
28  !> @brief type representing package subpackage list
30  character(len=LENCOMPONENTNAME), dimension(:), allocatable :: pkgtypes
31  character(len=LENCOMPONENTNAME), dimension(:), allocatable :: component_types
32  character(len=LENCOMPONENTNAME), dimension(:), &
33  allocatable :: subcomponent_types
34  character(len=LINELENGTH), dimension(:), allocatable :: filenames
35  character(len=LENMEMPATH) :: mempath
36  character(len=LENCOMPONENTNAME) :: component_name
37  integer(I4B) :: pnum
38  contains
39  procedure :: create => subpkg_create
40  procedure :: add => subpkg_add
41  procedure :: destroy => subpkg_destroy
42  end type subpackagelisttype
43 
44  !> @brief Static loader type
45  !!
46  !! This type is a base concrete type for a static input loader
47  !!
48  !<
50  type(modflowinputtype) :: mf6_input !< description of modflow6 input
51  type(ncpackagevarstype), pointer :: nc_vars => null()
52  character(len=LENCOMPONENTNAME) :: component_name !< name of component
53  character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file
54  character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file
55  integer(I4B) :: iperblock !< index of period block on block definition list
56  type(subpackagelisttype) :: subpkg_list !< list of input subpackages
57  contains
58  procedure :: init => static_init
59  procedure :: create_subpkg_list
60  procedure :: destroy => static_destroy
61  end type staticpkgloadtype
62 
63  !> @brief Base abstract type for static input loader
64  !!
65  !! IDM sources should extend and implement this type
66  !!
67  !<
68  type, abstract, extends(staticpkgloadtype) :: staticpkgloadbasetype
69  contains
70  procedure(load_if), deferred :: load
71  end type staticpkgloadbasetype
72 
73  !> @brief Dynamic loader type
74  !!
75  !! This type is a base concrete type for a dynamic (period) input loader
76  !!
77  !<
79  type(modflowinputtype) :: mf6_input !< description of modflow6 input
80  type(ncpackagevarstype), pointer :: nc_vars => null()
81  character(len=LENCOMPONENTNAME) :: component_name !< name of component
82  character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file
83  character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file
84  character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames
85  logical(LGP) :: readasarrays !< is this array based input
86  integer(I4B) :: iperblock !< index of period block on block definition list
87  integer(I4B) :: iout !< inunit number for logging
88  integer(I4B) :: nparam !< number of in scope params
89  contains
90  procedure :: init => dynamic_init
91  procedure :: df => dynamic_df
92  procedure :: ad => dynamic_ad
93  procedure :: destroy => dynamic_destroy
94  end type dynamicpkgloadtype
95 
96  !> @brief Base abstract type for dynamic input loader
97  !!
98  !! IDM sources should extend and implement this type
99  !!
100  !<
101  type, abstract, extends(dynamicpkgloadtype) :: dynamicpkgloadbasetype
102  contains
103  procedure(period_load_if), deferred :: rp
104  end type dynamicpkgloadbasetype
105 
106  !> @brief load interfaces for source static and dynamic types
107  !<
108  abstract interface
109  function load_if(this, iout) result(dynamic_loader)
111  class(staticpkgloadbasetype), intent(inout) :: this
112  integer(I4B), intent(in) :: iout
113  class(dynamicpkgloadbasetype), pointer :: dynamic_loader
114  end function load_if
115  subroutine period_load_if(this)
116  import dynamicpkgloadbasetype, i4b
117  class(dynamicpkgloadbasetype), intent(inout) :: this
118  end subroutine
119  end interface
120 
121  !> @brief type for storing a dynamic package load list
122  !!
123  !! This type is used to store a list of package
124  !! dynamic load types for a model
125  !!
126  !<
128  character(len=LENCOMPONENTNAME) :: modeltype !< type of model
129  character(len=LENMODELNAME) :: modelname !< name of model
130  character(len=LINELENGTH) :: modelfname !< name of model input file
131  type(listtype) :: pkglist !< model package list
132  character(len=LINELENGTH) :: nc_fname !< name of model netcdf input
133  integer(I4B) :: ncid !< netcdf file handle
134  integer(I4B) :: iout
135  contains
136  procedure :: init => dynamicpkgs_init
137  procedure :: add => dynamicpkgs_add
138  procedure :: get => dynamicpkgs_get
139  procedure :: rp => dynamicpkgs_rp
140  procedure :: df => dynamicpkgs_df
141  procedure :: ad => dynamicpkgs_ad
142  procedure :: size => dynamicpkgs_size
143  procedure :: destroy => dynamicpkgs_destroy
144  end type modeldynamicpkgstype
145 
147 
148 contains
149 
150  !> @brief create a new package type
151  !<
152  subroutine subpkg_create(this, mempath, component_name)
153  class(subpackagelisttype) :: this
154  character(len=*), intent(in) :: mempath
155  character(len=*), intent(in) :: component_name
156 
157  ! initialize
158  this%pnum = 0
159  this%mempath = mempath
160  this%component_name = component_name
161 
162  ! allocate arrays
163  allocate (this%pkgtypes(0))
164  allocate (this%component_types(0))
165  allocate (this%subcomponent_types(0))
166  allocate (this%filenames(0))
167  end subroutine subpkg_create
168 
169  !> @brief create a new package type
170  !<
171  subroutine subpkg_add(this, pkgtype, component_type, subcomponent_type, &
172  tagname, filename)
177  class(subpackagelisttype) :: this
178  character(len=*), intent(in) :: pkgtype
179  character(len=*), intent(in) :: component_type
180  character(len=*), intent(in) :: subcomponent_type
181  character(len=*), intent(in) :: tagname
182  character(len=*), intent(in) :: filename
183  character(len=LENVARNAME) :: mempath_tag
184  character(len=LENMEMPATH), pointer :: subpkg_mempath
185  character(len=LINELENGTH), pointer :: input_fname
186  integer(I4B) :: idx, trimlen
187 
188  ! reallocate
189  call expandarray(this%pkgtypes)
190  call expandarray(this%component_types)
191  call expandarray(this%subcomponent_types)
192  call expandarray(this%filenames)
193 
194  ! add new package instance
195  this%pnum = this%pnum + 1
196  this%pkgtypes(this%pnum) = pkgtype
197  this%component_types(this%pnum) = component_type
198  this%subcomponent_types(this%pnum) = subcomponent_type
199  this%filenames(this%pnum) = filename
200 
201  ! initialize mempath tag
202  mempath_tag = tagname
203  trimlen = len_trim(tagname)
204  idx = 0
205 
206  ! create mempath tagname
207  idx = index(tagname, '_')
208  if (idx > 0) then
209  if (tagname(idx + 1:trimlen) == 'FILENAME') then
210  write (mempath_tag, '(a)') tagname(1:idx)//'MEMPATH'
211  end if
212  end if
213 
214  ! allocate mempath variable for subpackage
215  call mem_allocate(subpkg_mempath, lenmempath, mempath_tag, &
216  this%mempath)
217 
218  ! create and set the mempath
219  subpkg_mempath = &
220  create_mem_path(this%component_name, &
221  subcomponent_type, idm_context)
222 
223  ! allocate and initialize filename for subpackage
224  call mem_allocate(input_fname, linelength, 'INPUT_FNAME', subpkg_mempath)
225  input_fname = filename
226  end subroutine subpkg_add
227 
228  !> @brief create a new package type
229  !<
230  subroutine subpkg_destroy(this)
231  class(subpackagelisttype) :: this
232  ! allocate arrays
233  deallocate (this%pkgtypes)
234  deallocate (this%component_types)
235  deallocate (this%subcomponent_types)
236  deallocate (this%filenames)
237  end subroutine subpkg_destroy
238 
239  !> @brief initialize static package loader
240  !!
241  !<
242  subroutine static_init(this, mf6_input, component_name, component_input_name, &
243  input_name)
244  class(staticpkgloadtype), intent(inout) :: this
245  type(modflowinputtype), intent(in) :: mf6_input
246  character(len=*), intent(in) :: component_name
247  character(len=*), intent(in) :: component_input_name
248  character(len=*), intent(in) :: input_name
249  integer(I4B) :: iblock
250 
251  this%mf6_input = mf6_input
252  this%component_name = component_name
253  this%component_input_name = component_input_name
254  this%input_name = input_name
255  this%iperblock = 0
256 
257  ! create subpackage list
258  call this%subpkg_list%create(this%mf6_input%mempath, &
259  this%mf6_input%component_name)
260 
261  ! identify period block definition
262  do iblock = 1, size(mf6_input%block_dfns)
263  if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') then
264  this%iperblock = iblock
265  exit
266  end if
267  end do
268  end subroutine static_init
269 
270  !> @brief create the subpackage list
271  !!
272  !<
273  subroutine create_subpkg_list(this)
277  class(staticpkgloadtype), intent(inout) :: this
278  character(len=16), dimension(:), pointer :: subpkgs
279  character(len=LINELENGTH) :: tag, fname, pkgtype
280  character(len=LENFTYPE) :: c_type, sc_type
281  character(len=16) :: subpkg
282  integer(I4B) :: idx, n
283 
284  ! set pointer to package (idm integrated) subpackage list
285  subpkgs => idm_subpackages(this%mf6_input%component_type, &
286  this%mf6_input%subcomponent_type)
287 
288  ! check if tag matches subpackage
289  do n = 1, size(subpkgs)
290  subpkg = subpkgs(n)
291  idx = index(subpkg, '-')
292  ! split sp string into component/subcomponent
293  if (idx > 0) then
294  ! split string in component/subcomponent types
295  c_type = subpkg(1:idx - 1)
296  sc_type = subpkg(idx + 1:len_trim(subpkg))
297  if (idm_integrated(c_type, sc_type)) then
298  ! set pkgtype and input filename tag
299  pkgtype = trim(sc_type)//'6'
300  tag = trim(pkgtype)//'_FILENAME'
301  ! support single instance of each subpackage
302  if (idm_multi_package(c_type, sc_type)) then
303  errmsg = 'Multi-instance subpackages not supported. Remove dfn &
304  &subpackage tagline for package "'//trim(subpkg)//'".'
305  call store_error(errmsg)
306  call store_error_filename(this%input_name)
307  else
308  if (filein_fname(fname, tag, this%mf6_input%mempath, &
309  this%input_name)) then
310  call this%subpkg_list%add(pkgtype, c_type, sc_type, &
311  trim(tag), trim(fname))
312  end if
313  end if
314  else
315  errmsg = 'Identified subpackage is not IDM integrated. Remove dfn &
316  &subpackage tagline for package "'//trim(subpkg)//'".'
317  call store_error(errmsg)
318  call store_error_filename(this%input_name)
319  end if
320  end if
321  end do
322  end subroutine create_subpkg_list
323 
324  subroutine static_destroy(this)
325  class(staticpkgloadtype), intent(inout) :: this
326  call this%subpkg_list%destroy()
327  if (associated(this%nc_vars)) then
328  call this%nc_vars%destroy()
329  deallocate (this%nc_vars)
330  nullify (this%nc_vars)
331  end if
332  end subroutine static_destroy
333 
334  !> @brief initialize dynamic package loader
335  !!
336  !! Any managed memory pointed to from model/package context
337  !! must be allocated when dynamic loader is initialized.
338  !!
339  !<
340  subroutine dynamic_init(this, mf6_input, component_name, component_input_name, &
341  input_name, iperblock, iout)
342  use simvariablesmodule, only: errmsg
344  class(dynamicpkgloadtype), intent(inout) :: this
345  type(modflowinputtype), intent(in) :: mf6_input
346  character(len=*), intent(in) :: component_name
347  character(len=*), intent(in) :: component_input_name
348  character(len=*), intent(in) :: input_name
349  integer(I4B), intent(in) :: iperblock
350  integer(I4B), intent(in) :: iout
351  type(inputparamdefinitiontype), pointer :: idt
352 
353  this%mf6_input = mf6_input
354  this%component_name = component_name
355  this%component_input_name = component_input_name
356  this%input_name = input_name
357  this%iperblock = iperblock
358  this%nparam = 0
359  this%iout = iout
360  nullify (idt)
361 
362  ! throw error and exit if not found
363  if (this%iperblock == 0) then
364  write (errmsg, '(a,a)') &
365  'Programming error. (IDM) PERIOD block not found in '&
366  &'dynamic package input block dfns: ', &
367  trim(mf6_input%subcomponent_name)
368  call store_error(errmsg)
369  call store_error_filename(this%input_name)
370  end if
371 
372  ! set readasarrays
373  this%readasarrays = (.not. mf6_input%block_dfns(iperblock)%aggregate)
374  end subroutine dynamic_init
375 
376  !> @brief dynamic package loader define
377  !!
378  !<
379  subroutine dynamic_df(this)
380  class(dynamicpkgloadtype), intent(inout) :: this
381  ! override in derived type
382  end subroutine dynamic_df
383 
384  !> @brief dynamic package loader advance
385  !!
386  !<
387  subroutine dynamic_ad(this)
388  class(dynamicpkgloadtype), intent(inout) :: this
389  ! override in derived type
390  end subroutine dynamic_ad
391 
392  !> @brief dynamic package loader destroy
393  !!
394  !<
395  subroutine dynamic_destroy(this)
399  class(dynamicpkgloadtype), intent(inout) :: this
400 
401  ! clean up netcdf variables structure
402  if (associated(this%nc_vars)) then
403  call this%nc_vars%destroy()
404  deallocate (this%nc_vars)
405  nullify (this%nc_vars)
406  end if
407 
408  ! deallocate package static and dynamic input context
409  call memorystore_remove(this%mf6_input%component_name, &
410  this%mf6_input%subcomponent_name, &
411  idm_context)
412  end subroutine dynamic_destroy
413 
414  !> @brief model dynamic packages init
415  !!
416  !<
417  subroutine dynamicpkgs_init(this, modeltype, modelname, modelfname, nc_fname, &
418  ncid, iout)
419  class(modeldynamicpkgstype), intent(inout) :: this
420  character(len=*), intent(in) :: modeltype
421  character(len=*), intent(in) :: modelname
422  character(len=*), intent(in) :: modelfname
423  character(len=*), intent(in) :: nc_fname
424  integer(I4B), intent(in) :: ncid
425  integer(I4B), intent(in) :: iout
426  this%modeltype = modeltype
427  this%modelname = modelname
428  this%modelfname = modelfname
429  this%nc_fname = nc_fname
430  this%ncid = ncid
431  this%iout = iout
432  end subroutine dynamicpkgs_init
433 
434  !> @brief add package to model dynamic packages list
435  !!
436  !<
437  subroutine dynamicpkgs_add(this, dynamic_pkg)
438  class(modeldynamicpkgstype), intent(inout) :: this
439  class(dynamicpkgloadbasetype), pointer, intent(inout) :: dynamic_pkg
440  class(*), pointer :: obj
441  obj => dynamic_pkg
442  call this%pkglist%add(obj)
443  end subroutine dynamicpkgs_add
444 
445  !> @brief retrieve package from model dynamic packages list
446  !!
447  !<
448  function dynamicpkgs_get(this, idx) result(res)
449  class(modeldynamicpkgstype), intent(inout) :: this
450  integer(I4B), intent(in) :: idx
451  class(dynamicpkgloadbasetype), pointer :: res
452  class(*), pointer :: obj
453  nullify (res)
454  obj => this%pkglist%GetItem(idx)
455  if (associated(obj)) then
456  select type (obj)
457  class is (dynamicpkgloadbasetype)
458  res => obj
459  end select
460  end if
461  end function dynamicpkgs_get
462 
463  !> @brief read and prepare model dynamic packages
464  !!
465  !<
466  subroutine dynamicpkgs_rp(this)
468  class(modeldynamicpkgstype), intent(inout) :: this
469  class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
470  integer(I4B) :: n
471  call idm_log_period_header(this%modelname, this%iout)
472  do n = 1, this%pkglist%Count()
473  dynamic_pkg => this%get(n)
474  call dynamic_pkg%rp()
475  end do
476  call idm_log_period_close(this%iout)
477  end subroutine dynamicpkgs_rp
478 
479  !> @brief define model dynamic packages
480  !!
481  !<
482  subroutine dynamicpkgs_df(this)
483  class(modeldynamicpkgstype), intent(inout) :: this
484  class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
485  integer(I4B) :: n
486  do n = 1, this%pkglist%Count()
487  dynamic_pkg => this%get(n)
488  call dynamic_pkg%df()
489  end do
490  end subroutine dynamicpkgs_df
491 
492  !> @brief advance model dynamic packages
493  !!
494  !<
495  subroutine dynamicpkgs_ad(this)
496  class(modeldynamicpkgstype), intent(inout) :: this
497  class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
498  integer(I4B) :: n
499  do n = 1, this%pkglist%Count()
500  dynamic_pkg => this%get(n)
501  call dynamic_pkg%ad()
502  end do
503  end subroutine dynamicpkgs_ad
504 
505  !> @brief get size of model dynamic packages list
506  !!
507  !<
508  function dynamicpkgs_size(this) result(size)
509  class(modeldynamicpkgstype), intent(inout) :: this
510  integer(I4B) :: size
511  size = this%pkglist%Count()
512  end function dynamicpkgs_size
513 
514  !> @brief destroy model dynamic packages object
515  !!
516  !<
517  subroutine dynamicpkgs_destroy(this)
518  class(modeldynamicpkgstype), intent(inout) :: this
519  class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
520  integer(I4B) :: n
521  ! destroy dynamic loaders
522  do n = 1, this%pkglist%Count()
523  dynamic_pkg => this%get(n)
524  call dynamic_pkg%destroy()
525  deallocate (dynamic_pkg)
526  nullify (dynamic_pkg)
527  end do
528  call this%pkglist%Clear()
529  end subroutine dynamicpkgs_destroy
530 
531  !> @brief add model dynamic packages object to list
532  !!
533  !<
534  subroutine adddynamicmodeltolist(list, model_dynamic)
535  type(listtype), intent(inout) :: list !< package list
536  class(modeldynamicpkgstype), pointer, intent(inout) :: model_dynamic
537  class(*), pointer :: obj
538  obj => model_dynamic
539  call list%Add(obj)
540  end subroutine adddynamicmodeltolist
541 
542  !> @brief get model dynamic packages object from list
543  !!
544  !<
545  function getdynamicmodelfromlist(list, idx) result(res)
546  type(listtype), intent(inout) :: list !< spd list
547  integer(I4B), intent(in) :: idx !< package number
548  class(modeldynamicpkgstype), pointer :: res
549  class(*), pointer :: obj
550  ! initialize res
551  nullify (res)
552  ! get the object from the list
553  obj => list%GetItem(idx)
554  if (associated(obj)) then
555  select type (obj)
556  class is (modeldynamicpkgstype)
557  res => obj
558  end select
559  end if
560  end function getdynamicmodelfromlist
561 
562 end module inputloadtypemodule
subroutine init()
Definition: GridSorting.f90:24
load interfaces for source static and dynamic types
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lencomponentname
maximum length of a component name
Definition: Constants.f90:18
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:39
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
logical function, public idm_integrated(component, subcomponent)
logical function, public idm_multi_package(component, subcomponent)
character(len=16) function, dimension(:), pointer, public idm_subpackages(component, subcomponent)
This module contains the Input Data Model Logger Module.
Definition: IdmLogger.f90:7
subroutine, public idm_log_period_header(component, iout)
@ brief log a dynamic header message
Definition: IdmLogger.f90:67
subroutine, public idm_log_period_close(iout)
@ brief log the period closing message
Definition: IdmLogger.f90:79
This module contains the InputDefinitionModule.
This module contains the InputLoadTypeModule.
subroutine dynamic_ad(this)
dynamic package loader advance
subroutine static_init(this, mf6_input, component_name, component_input_name, input_name)
initialize static package loader
subroutine subpkg_destroy(this)
create a new package type
subroutine dynamicpkgs_init(this, modeltype, modelname, modelfname, nc_fname, ncid, iout)
model dynamic packages init
class(modeldynamicpkgstype) function, pointer, public getdynamicmodelfromlist(list, idx)
get model dynamic packages object from list
subroutine create_subpkg_list(this)
create the subpackage list
integer(i4b) function dynamicpkgs_size(this)
get size of model dynamic packages list
subroutine dynamic_init(this, mf6_input, component_name, component_input_name, input_name, iperblock, iout)
initialize dynamic package loader
subroutine, public adddynamicmodeltolist(list, model_dynamic)
add model dynamic packages object to list
subroutine dynamicpkgs_add(this, dynamic_pkg)
add package to model dynamic packages list
subroutine dynamicpkgs_rp(this)
read and prepare model dynamic packages
subroutine subpkg_create(this, mempath, component_name)
create a new package type
subroutine static_destroy(this)
subroutine subpkg_add(this, pkgtype, component_type, subcomponent_type, tagname, filename)
create a new package type
subroutine dynamicpkgs_destroy(this)
destroy model dynamic packages object
class(dynamicpkgloadbasetype) function, pointer dynamicpkgs_get(this, idx)
retrieve package from model dynamic packages list
subroutine dynamicpkgs_ad(this)
advance model dynamic packages
subroutine dynamic_destroy(this)
dynamic package loader destroy
type(listtype), public model_dynamic_pkgs
subroutine dynamic_df(this)
dynamic package loader define
subroutine dynamicpkgs_df(this)
define model dynamic packages
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorystore_remove(component, subcomponent, context)
This module contains the ModflowInputModule.
Definition: ModflowInput.f90:9
This module contains the NCFileVarsModule.
Definition: NCFileVars.f90:7
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
logical(lgp) function, public filein_fname(filename, tagname, input_mempath, input_fname)
enforce and set a single input filename provided via FILEIN keyword
Base abstract type for dynamic input loader.
type for storing a dynamic package load list
Base abstract type for static input loader.
type representing package subpackage list
A generic heterogeneous doubly-linked list.
Definition: List.f90:14
derived type for storing input definition for a file
Type describing input variables for a package in NetCDF file.
Definition: NCFileVars.f90:22