MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
SourceLoad.F90
Go to the documentation of this file.
1 !> @brief This module contains the SourceLoadModule
2 !!
3 !! This module contains the routines needed to generate
4 !! a loader object for an input source and routines
5 !! that distribute processing to a particular source.
6 !!
7 !<
9 
10  use kindmodule, only: dp, i4b, lgp
11  use simvariablesmodule, only: errmsg, iout
17 
18  implicit none
19  private
20  public :: create_input_loader
21  public :: open_source_file
23  public :: remote_model_ndim
24  public :: export_cr, export_da
26  public :: nc_close
27  public :: netcdf_context
28 
29 contains
30 
31  !> @brief factory function to create and setup model package static loader
32  !<
33  function create_input_loader(component_type, subcomponent_type, &
34  component_name, subcomponent_name, input_type, &
35  input_fname, component_fname, nc_vars) &
36  result(loader)
39  character(len=*), intent(in) :: component_type
40  character(len=*), intent(in) :: subcomponent_type
41  character(len=*), intent(in) :: component_name
42  character(len=*), intent(in) :: subcomponent_name
43  character(len=*), intent(in) :: input_type
44  character(len=*), intent(in) :: input_fname
45  character(len=*), intent(in) :: component_fname
46  type(ncfilevarstype), pointer, optional, intent(in) :: nc_vars
47  class(staticpkgloadbasetype), pointer :: loader
48  type(modflowinputtype) :: mf6_input
49  character(len=LENPACKAGENAME) :: source_type
50  character(len=LENPACKAGENAME) :: sc_name
51  !
52  ! -- set subcomponent name
53  sc_name = idm_subcomponent_name(component_type, subcomponent_type, &
54  subcomponent_name)
55  !
56  ! -- create description of input
57  mf6_input = getmodflowinput(input_type, component_type, subcomponent_type, &
58  component_name, sc_name, input_fname)
59  !
60  ! -- set package source
61  source_type = package_source_type(input_fname)
62  !
63  ! -- set source loader for model package
64  loader => package_loader(source_type)
65  !
66  ! -- initialize loader
67  call loader%init(mf6_input, component_name, component_fname, input_fname)
68  !
69  ! -- initialize loader netcdf variables data structure
70  if (present(nc_vars)) then
71  call nc_vars%create_varlists(component_name, sc_name, loader%nc_vars)
72  else
73  call loader%nc_vars%init(component_name)
74  end if
75  !
76  ! -- return
77  return
78  end function create_input_loader
79 
80  !> @brief allocate source model package static loader
81  !<
82  function package_loader(source_type) result(loader)
85  character(len=*), intent(inout) :: source_type
86  class(mf6filestaticpkgloadtype), pointer :: mf6file_loader
87  class(staticpkgloadbasetype), pointer :: loader
88  !
89  ! -- initialize
90  nullify (loader)
91  !
92  ! -- allocate derived object
93  select case (source_type)
94  case ('MF6FILE')
95  allocate (mf6file_loader)
96  loader => mf6file_loader
97  allocate (loader%nc_vars)
98  case default
99  write (errmsg, '(a)') &
100  'Simulation package input source type "'//trim(source_type)// &
101  '" not currently supported.'
102  call store_error(errmsg, .true.)
103  end select
104  !
105  ! -- return
106  return
107  end function package_loader
108 
109  function open_source_file(pkgtype, filename, modelfname, iout) result(fd)
111  use idmmf6filemodule, only: open_mf6file
112  character(len=*), intent(in) :: pkgtype
113  character(len=*), intent(in) :: filename
114  character(len=*), intent(in) :: modelfname
115  integer(I4B), intent(in) :: iout
116  integer(I4B) :: fd
117  character(len=LENPACKAGENAME) :: source_type
118  !
119  ! -- initialize
120  fd = 0
121  !
122  ! -- set source type
123  source_type = package_source_type(filename)
124  !
125  select case (source_type)
126  case ('MF6FILE')
127  fd = open_mf6file(pkgtype, filename, modelfname, iout)
128  case default
129  end select
130  !
131  ! -- return
132  return
133  end function open_source_file
134 
135  subroutine load_modelnam(mtype, mfname, mname, iout)
136  use simvariablesmodule, only: simfile
138  use idmmf6filemodule, only: input_load
139  character(len=*), intent(in) :: mtype
140  character(len=*), intent(in) :: mfname
141  character(len=*), intent(in) :: mname
142  integer(I4B), intent(in) :: iout
143  type(modflowinputtype) :: mf6_input
144  character(len=LENPACKAGENAME) :: source_type
145  !
146  ! -- set source type
147  source_type = package_source_type(mfname)
148  !
149  ! -- create description of input
150  mf6_input = getmodflowinput(mtype, idm_component_type(mtype), 'NAM', &
151  mname, 'NAM', mfname)
152  !
153  select case (source_type)
154  case ('MF6FILE')
155  call input_load(mfname, mf6_input, simfile, iout)
156  case default
157  end select
158  !
159  ! -- return
160  return
161  end subroutine load_modelnam
162 
163  subroutine load_simnam()
164  use simvariablesmodule, only: simfile, iout
166  use messagemodule, only: write_message
167  use idmmf6filemodule, only: input_load
169  type(modflowinputtype) :: mf6_input, hpc_input
170  character(len=LINELENGTH) :: hpc6_filename
171  character(len=LINELENGTH) :: line
172  logical :: lexist
173  !
174  ! -- load mfsim.nam if it exists
175  inquire (file=trim(adjustl(simfile)), exist=lexist)
176  !
177  if (lexist) then
178  !
179  ! -- write name of namfile to stdout
180  write (line, '(2(1x,a))') 'Using Simulation name file:', &
181  trim(adjustl(simfile))
182  call write_message(line, skipafter=1)
183  !
184  ! -- create description of input
185  mf6_input = getmodflowinput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', simfile)
186  !
187  ! -- open namfile and load to input context
188  call input_load(simfile, mf6_input, simfile, iout)
189  !
190  ! -- load optional HPC configuration file
191  if (filein_fname(hpc6_filename, 'HPC6_FILENAME', mf6_input%mempath, &
192  simfile)) then
193  hpc_input = getmodflowinput('HPC6', 'UTL', 'HPC', 'UTL', 'HPC')
194  call input_load(hpc6_filename, hpc_input, simfile, iout)
195  end if
196  end if
197  !
198  ! -- return
199  return
200  end subroutine load_simnam
201 
202  subroutine load_simtdis()
203  ! -- modules
204  use simvariablesmodule, only: simfile, iout
209  use idmmf6filemodule, only: input_load
210  ! -- dummy
211  ! -- locals
212  character(len=LENMEMPATH) :: input_mempath
213  type(modflowinputtype) :: mf6_input
214  character(len=LENPACKAGENAME) :: source_type
215  character(len=:), pointer :: tdis6
216  logical :: lexist
217  !
218  ! -- set input memory path
219  input_mempath = create_mem_path('SIM', 'NAM', idm_context)
220  !
221  ! -- set pointers to input context timing params
222  call mem_setptr(tdis6, 'TDIS6', input_mempath)
223  !
224  ! -- create timing
225  if (tdis6 /= '') then
226  !
227  ! -- set source type
228  source_type = package_source_type(tdis6)
229  !
230  select case (source_type)
231  case ('MF6FILE')
232  !
233  inquire (file=trim(adjustl(tdis6)), exist=lexist)
234  !
235  if (lexist) then
236  !
237  ! -- create description of input
238  mf6_input = getmodflowinput('TDIS6', 'SIM', 'TDIS', &
239  'SIM', 'TDIS', simfile)
240  !
241  ! -- open namfile and load to input context
242  call input_load(tdis6, mf6_input, simfile, iout)
243  !
244  else
245  write (errmsg, '(a)') &
246  'Simulation TIMING input file "'//trim(tdis6)// &
247  '" does not exist.'
248  call store_error(errmsg)
249  call store_error_filename(simfile)
250  end if
251  case default
252  end select
253  end if
254  !
255  ! -- return
256  return
257  end subroutine load_simtdis
258 
259  function remote_model_ndim(mtype, mfname) result(ncelldim)
261  use constantsmodule, only: linelength
264  character(len=*), intent(in) :: mtype
265  character(len=*), intent(in) :: mfname
266  integer(I4B) :: ncelldim
267  character(len=LENPACKAGENAME) :: source_type
268  type(blockparsertype) :: parser
269  integer(I4B) :: ierr, inunit
270  logical(LGP) :: isfound, endofblock
271  character(len=LINELENGTH) :: ptype
272  !
273  ! -- initialize
274  ncelldim = 0
275  !
276  ! -- set source type
277  source_type = package_source_type(mfname)
278  !
279  select case (source_type)
280  case ('MF6FILE')
281  !
282  ! -- open name file
283  inunit = getunit()
284  call openfile(inunit, 0, trim(adjustl(mfname)), mtype, &
285  'FORMATTED', 'SEQUENTIAL', 'OLD')
286  !
287  ! -- initialize parser
288  call parser%Initialize(inunit, 0)
289  !
290  ! -- get options block
291  call parser%GetBlock('OPTIONS', isfound, ierr, &
292  supportopenclose=.true., blockrequired=.false.)
293  ! -- iterate through options
294  if (isfound) then
295  do
296  call parser%GetNextLine(endofblock)
297  if (endofblock) exit
298  end do
299  end if
300  !
301  ! -- get packages block
302  call parser%GetBlock('PACKAGES', isfound, ierr, &
303  supportopenclose=.true., blockrequired=.true.)
304  if (isfound) then
305  ! -- read through packages
306  do
307  call parser%GetNextLine(endofblock)
308  if (endofblock) exit
309  !
310  call parser%GetStringCaps(ptype)
311  !
312  select case (ptype)
313  case ('DIS6')
314  ncelldim = 3
315  exit
316  case ('DIS2D6')
317  ncelldim = 2
318  exit
319  case ('DISV6')
320  ncelldim = 2
321  exit
322  case ('DISU6')
323  ncelldim = 1
324  exit
325  case default
326  write (errmsg, '(a)') &
327  'Unknown discretization type "'//trim(ptype)// &
328  '" not currently supported.'
329  call store_error(errmsg, .true.)
330  end select
331  end do
332  end if
333  !
334  call parser%clear()
335  !
336  case default
337  end select
338  !
339  ! -- return
340  return
341  end function remote_model_ndim
342 
343  !> @brief create model exports list
344  !<
345  subroutine export_cr()
346  ! -- modules
348 #if defined(__WITH_NETCDF__)
350 #endif
352  !
353  ! -- are netcdf exports elected
354  if (nc_export_active()) then
355 #if defined(__WITH_NETCDF__)
356  call nc_export_create()
357 #else
358  write (errmsg, '(a)') &
359  'Model namefile EXPORT_NETCDF option configured but NetCDF libraries are &
360  &not available.'
361  call store_error(errmsg, .true.)
362 #endif
363  end if
364  end subroutine export_cr
365 
366  !> @brief model exports post prepare step actions
367  !<
368  subroutine export_post_prepare()
369  ! -- modules
372  end subroutine export_post_prepare
373 
374  !> @brief model exports post step actions
375  !<
376  subroutine export_post_step()
377  ! -- modules
380  end subroutine export_post_step
381 
382  !> @brief deallocate model export objects and list
383  !<
384  subroutine export_da()
385  ! -- modules
387  call modelexports_destroy()
388  end subroutine export_da
389 
390  !> @brief close an open netcdf file
391  !<
392  subroutine nc_close(ncid, nc_fname)
393 #if defined(__WITH_NETCDF__)
394  use netcdfcommonmodule, only: nc_fclose
395 #endif
396  integer(I4B), intent(in) :: ncid
397  character(len=*), intent(in) :: nc_fname
398  !
399  if (ncid > 0) then
400 #if defined(__WITH_NETCDF__)
401  call nc_fclose(ncid, nc_fname)
402 #endif
403  end if
404  !
405  return
406  end subroutine nc_close
407 
408  !> @brief create model netcdf context
409  !<
410  function netcdf_context(modeltype, component_type, modelname, &
411  modelfname, iout) result(nc_vars)
415 #if defined(__WITH_NETCDF__)
417 #endif
418  ! -- dummy
419  character(len=*), intent(in) :: modeltype
420  character(len=*), intent(in) :: component_type
421  character(len=*), intent(in) :: modelname
422  character(len=*), intent(in) :: modelfname
423  integer(I4B), intent(in) :: iout
424  ! -- return
425  type(ncfilevarstype), pointer :: nc_vars
426  ! -- local
427  character(len=LENMEMPATH) :: input_mempath
428  character(len=LINELENGTH) :: nc_fname
429  integer(I4B) :: ncid
430  !
431  ! -- set input memory path
432  input_mempath = create_mem_path(modelname, 'NAM', idm_context)
433  !
434  ! -- allocate context object
435  allocate (nc_vars)
436  !
437  ! -- check if optional netcdf input file was provided
438  if (filein_fname(nc_fname, 'NETCDF_FNAME', input_mempath, modelfname)) then
439 #if defined(__WITH_NETCDF__)
440  !
441  ! -- open nc input file
442  ncid = open_ncfile(nc_fname, iout)
443  !
444  ! -- read the file and build the context
445  call create_netcdf_context(modeltype, modelname, modelfname, &
446  nc_vars, nc_fname, ncid, iout)
447  !
448 #else
449  write (errmsg, '(a)') &
450  'Cannot load model packages. NetCDF &
451  &keyword specified in input file but &
452  &NetCDF libraries are not available.'
453  call store_error(errmsg)
454  call store_error_filename(modelfname)
455 #endif
456  else
457  ncid = 0
458  call nc_vars%init(modelname, '', ncid, '')
459  end if
460  !
461  ! -- return
462  return
463  end function netcdf_context
464 
465 end module sourceloadmodule
This module contains block parser methods.
Definition: BlockParser.f90:7
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 lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
Definition: Constants.f90:38
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
This module contains the IdmMf6FileModule.
Definition: IdmMf6File.f90:10
integer(i4b) function, public open_mf6file(filetype, filename, component_fname, iout)
open a model package files
Definition: IdmMf6File.f90:357
subroutine, public input_load(filename, mf6_input, component_filename, iout, nc_vars)
input load for traditional mf6 simulation static input file
Definition: IdmMf6File.f90:59
This module contains the InputLoadTypeModule.
integer(i4b) function, public getunit()
Get a free unit number.
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
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
Store and issue logging messages to output units.
Definition: Message.f90:2
subroutine, public write_message(text, iunit, fmt, skipbefore, skipafter, advance)
Write a message to an output unit.
Definition: Message.f90:210
This module contains the ModelExportModule.
Definition: ModelExport.f90:8
subroutine, public modelexports_post_prepare()
export model list post prepare step
subroutine, public modelexports_destroy()
destroy export model list
subroutine, public modelexports_post_step()
export model list post step
subroutine, public modelexports_create(iout)
create export container variable for all local models
Definition: ModelExport.f90:75
logical(lgp) function, public nc_export_active()
is netcdf export configured for any model
Definition: ModelExport.f90:57
This module contains the ModflowInputModule.
Definition: ModflowInput.f90:9
type(modflowinputtype) function, public getmodflowinput(pkgtype, component_type, subcomponent_type, component_name, subcomponent_name, filename)
function to return ModflowInputType
This module contains the NCContextBuildModule.
integer(i4b) function, public open_ncfile(nc_fname, iout)
open netcdf file
subroutine, public create_netcdf_context(modeltype, modelname, input_name, nc_vars, nc_fname, ncid, iout)
create internal description of modflow6 input variables in netcdf file
This module contains the NCExportCreateModule.
subroutine, public nc_export_create()
initialize netcdf model export type
This module contains the NCFileVarsModule.
Definition: NCFileVars.f90:7
This module contains the NetCDFCommonModule.
Definition: NetCDFCommon.f90:6
subroutine, public nc_fclose(ncid, nc_fname)
Close netcdf file.
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
integer(i4b) iout
file unit number for simulation output
character(len=linelength) simfile
simulation name file
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
character(len=lenpackagename) function, public package_source_type(sourcename)
source identifier from model namfile FNAME array
character(len=lencomponentname) function, public idm_component_type(component)
component from package or model type
character(len=lenpackagename) function, public idm_subcomponent_name(component_type, subcomponent_type, sc_name)
model package subcomponent name
logical(lgp) function, public filein_fname(filename, tagname, input_mempath, input_fname)
enforce and set a single input filename provided via FILEIN keyword
This module contains the SourceLoadModule.
Definition: SourceLoad.F90:8
subroutine, public export_da()
deallocate model export objects and list
Definition: SourceLoad.F90:385
subroutine, public load_simnam()
Definition: SourceLoad.F90:164
integer(i4b) function, public open_source_file(pkgtype, filename, modelfname, iout)
Definition: SourceLoad.F90:110
subroutine, public load_simtdis()
Definition: SourceLoad.F90:203
class(staticpkgloadbasetype) function, pointer package_loader(source_type)
allocate source model package static loader
Definition: SourceLoad.F90:83
subroutine, public export_cr()
create model exports list
Definition: SourceLoad.F90:346
type(ncfilevarstype) function, pointer, public netcdf_context(modeltype, component_type, modelname, modelfname, iout)
create model netcdf context
Definition: SourceLoad.F90:412
subroutine, public nc_close(ncid, nc_fname)
close an open netcdf file
Definition: SourceLoad.F90:393
subroutine, public export_post_prepare()
model exports post prepare step actions
Definition: SourceLoad.F90:369
integer(i4b) function, public remote_model_ndim(mtype, mfname)
Definition: SourceLoad.F90:260
subroutine, public export_post_step()
model exports post step actions
Definition: SourceLoad.F90:377
class(staticpkgloadbasetype) function, pointer, public create_input_loader(component_type, subcomponent_type, component_name, subcomponent_name, input_type, input_fname, component_fname, nc_vars)
factory function to create and setup model package static loader
Definition: SourceLoad.F90:37
subroutine, public load_modelnam(mtype, mfname, mname, iout)
Definition: SourceLoad.F90:136
Base abstract type for static input loader.
derived type for storing input definition for a file
Type describing modflow6 input variables in model NetCDF file.
Definition: NCFileVars.f90:48