117 character(len=LENMEMPATH) :: input_mempath
118 integer(I4B),
pointer :: simcontinue, nocheck, maxerror
119 character(len=:),
pointer :: prmem
120 character(len=LINELENGTH) :: errmsg
126 call mem_setptr(simcontinue,
'CONTINUE', input_mempath)
127 call mem_setptr(nocheck,
'NOCHECK', input_mempath)
128 call mem_setptr(prmem,
'PRMEM', input_mempath)
129 call mem_setptr(maxerror,
'MAXERRORS', input_mempath)
136 if (prmem /=
'')
then
139 if (errmsg /=
'')
then
146 write (iout,
'(/1x,a)')
'READING SIMULATION OPTIONS'
149 write (iout,
'(4x, a)') &
150 'SIMULATION WILL CONTINUE EVEN IF THERE IS NONCONVERGENCE.'
154 write (iout,
'(4x, a)') &
155 'MODEL DATA WILL NOT BE CHECKED FOR ERRORS.'
158 write (iout,
'(4x, a, i0)') &
159 'MAXIMUM NUMBER OF ERRORS THAT WILL BE STORED IS ', maxerror
161 if (prmem /=
'')
then
162 write (iout,
'(4x, a, a, a)') &
163 'MEMORY_PRINT_OPTION SET TO "', trim(prmem),
'".'
166 write (iout,
'(1x,a)')
'END OF SIMULATION OPTIONS'
183 character(len=LENMEMPATH) :: input_mempath
184 character(len=LENMEMPATH) :: tdis_input_mempath
185 character(len=:),
pointer :: tdis6
186 logical :: terminate = .true.
192 write (iout,
'(/1x,a)')
'READING SIMULATION TIMING'
195 call mem_setptr(tdis6,
'TDIS6', input_mempath)
198 if (tdis6 /=
'')
then
199 call tdis_cr(tdis6, tdis_input_mempath)
201 call store_error(
'TIMING block variable TDIS6 is unset'// &
202 ' in simulation control input.', terminate)
205 write (iout,
'(1x,a)')
'END OF SIMULATION TIMING'
233 character(len=LENMEMPATH) :: input_mempath
242 character(len=LINELENGTH) :: model_type
243 character(len=LINELENGTH) :: fname, model_name
244 integer(I4B) :: n, nr_models_glob
245 integer(I4B),
dimension(:),
pointer :: model_ranks => null()
246 logical :: terminate = .true.
252 call mem_setptr(mtypes,
'MTYPE', input_mempath)
253 call mem_setptr(mfnames,
'MFNAME', input_mempath)
254 call mem_setptr(mnames,
'MNAME', input_mempath)
257 nr_models_glob =
size(mnames)
258 allocate (model_names(nr_models_glob))
259 allocate (model_loc_idx(nr_models_glob))
263 model_ranks => ds%get_load_balance()
266 write (iout,
'(/1x,a)')
'READING SIMULATION MODELS'
270 do n = 1,
size(mtypes)
273 model_type = mtypes(n)
275 model_name = mnames(n)
281 model_loc_idx(n) = -1
285 select case (model_type)
287 if (model_ranks(n) == proc_id)
then
289 write (iout,
'(4x,2a,i0,a)') trim(model_type),
' model ', &
290 n,
' will be created'
291 call gwf_cr(fname, n, model_names(n))
293 model_loc_idx(n) = im
297 if (model_ranks(n) == proc_id)
then
299 write (iout,
'(4x,2a,i0,a)') trim(model_type),
' model ', &
300 n,
' will be created'
301 call gwt_cr(fname, n, model_names(n))
303 model_loc_idx(n) = im
307 if (model_ranks(n) == proc_id)
then
309 write (iout,
'(4x,2a,i0,a)') trim(model_type),
' model ', &
310 n,
' will be created'
311 call gwe_cr(fname, n, model_names(n))
313 model_loc_idx(n) = im
317 if (model_ranks(n) == proc_id)
then
319 write (iout,
'(4x,2a,i0,a)') trim(model_type),
" model ", &
320 n,
" will be created"
321 call swf_cr(fname, n, model_names(n))
322 call dev_feature(
'SWF is still under development, install the &
323 &nightly build or compile from source with IDEVELOPMODE = 1.')
325 model_loc_idx(n) = im
329 write (iout,
'(4x,2a,i0,a)') trim(model_type),
' model ', &
330 n,
' will be created'
331 call prt_cr(fname, n, model_names(n))
332 call dev_feature(
'PRT is still under development, install the &
333 &nightly build or compile from source with IDEVELOPMODE = 1.')
335 model_loc_idx(n) = im
338 'Unknown simulation model type: ', trim(model_type)
344 write (iout,
'(1x,a)')
'END OF SIMULATION MODELS'
347 if (simulation_mode ==
'PARALLEL' .and. im == 0)
then
348 write (
errmsg,
'(a, i0)') &
349 'No MODELS assigned to process ', proc_id
377 character(len=LENMEMPATH) :: input_mempath
388 character(len=LINELENGTH) :: exgtype
389 integer(I4B) :: exg_id
390 integer(I4B) :: m1_id, m2_id
391 character(len=LINELENGTH) :: fname, name1, name2
392 character(len=LENEXCHANGENAME) :: exg_name
393 character(len=LENMEMPATH) :: exg_mempath
395 character(len=LINELENGTH) :: errmsg
396 logical(LGP) :: terminate = .true.
397 logical(LGP) :: both_remote, both_local
399 character(len=*),
parameter :: fmtmerr =
"('Error in simulation control ', &
400 &'file. Could not find model: ', a)"
406 call mem_setptr(etypes,
'EXGTYPE', input_mempath)
407 call mem_setptr(efiles,
'EXGFILE', input_mempath)
408 call mem_setptr(emnames_a,
'EXGMNAMEA', input_mempath)
409 call mem_setptr(emnames_b,
'EXGMNAMEB', input_mempath)
410 call mem_setptr(emempaths,
'EXGMEMPATHS', input_mempath)
413 write (iout,
'(/1x,a)')
'READING SIMULATION EXCHANGES'
419 do n = 1,
size(etypes)
426 exg_mempath = emempaths(n)
431 m1_id =
ifind(model_names, name1)
433 write (errmsg, fmtmerr) trim(name1)
436 m2_id =
ifind(model_names, name2)
438 write (errmsg, fmtmerr) trim(name2)
443 both_remote = (model_loc_idx(m1_id) == -1 .and. &
444 model_loc_idx(m2_id) == -1)
445 both_local = (model_loc_idx(m1_id) > 0 .and. &
446 model_loc_idx(m2_id) > 0)
447 if (.not. both_remote)
then
448 write (iout,
'(4x,a,a,i0,a,i0,a,i0)') trim(exgtype),
' exchange ', &
449 exg_id,
' will be created to connect model ', m1_id, &
450 ' with model ', m2_id
453 select case (exgtype)
455 write (exg_name,
'(a,i0)')
'GWF-GWF_', exg_id
456 if (.not. both_remote)
then
463 call gwfgwt_cr(fname, exg_id, m1_id, m2_id)
467 call gwfgwe_cr(fname, exg_id, m1_id, m2_id)
470 call gwfprt_cr(fname, exg_id, m1_id, m2_id)
472 write (exg_name,
'(a,i0)')
'GWT-GWT_', exg_id
473 if (.not. both_remote)
then
479 write (exg_name,
'(a,i0)')
'GWE-GWE_', exg_id
480 if (.not. both_remote)
then
486 write (exg_name,
'(a,i0)')
'SWF-GWF_', exg_id
488 call swfgwf_cr(fname, exg_name, exg_id, m1_id, m2_id, exg_mempath)
491 write (errmsg,
'(a,a)') &
492 'Unknown simulation exchange type: ', trim(exgtype)
498 write (iout,
'(1x,a)')
'END OF SIMULATION EXCHANGES'
510 integer(I4B),
intent(in) :: sgid
511 integer(I4B),
intent(in) :: isgpsoln
513 character(len=LINELENGTH) :: errmsg
514 logical :: terminate = .true.
516 character(len=*),
parameter :: fmterrmxiter = &
517 "('MXITER is set to ', i0, ' but there is only one solution', &
518 &' in SOLUTION GROUP ', i0, '. Set MXITER to 1 in simulation control', &
525 if (isgpsoln == 0)
then
526 write (errmsg,
'(a,i0)') &
527 'There are no solutions for solution group ', sgid
532 if (isgpsoln == 1 .and. sgp%mxiter > 1)
then
533 write (errmsg, fmterrmxiter) sgp%mxiter, isgpsoln
558 character(len=LENMEMPATH) :: input_mempath
565 integer(I4B),
dimension(:),
contiguous,
pointer :: blocknum
566 character(len=LINELENGTH) :: stype, fname
567 character(len=:),
allocatable :: mnames
571 integer(I4B) :: isoln
572 integer(I4B) :: isgpsoln
574 integer(I4B) :: glo_mid
575 integer(I4B) :: loc_idx
576 integer(I4B) :: i, j, istat, mxiter
577 integer(I4B) :: nwords
578 character(len=LENMODELNAME),
dimension(:),
allocatable :: words
579 character(len=:),
allocatable :: parse_str
580 character(len=LINELENGTH) :: errmsg
581 logical :: terminate = .true.
588 call mem_setptr(slntype,
'SLNTYPE', input_mempath)
589 call mem_setptr(slnfname,
'SLNFNAME', input_mempath)
590 call mem_setptr(slnmnames,
'SLNMNAMES', input_mempath)
591 call mem_setptr(blocknum,
'SOLUTIONGROUPNUM', input_mempath)
594 write (iout,
'(/1x,a)')
'READING SOLUTIONGROUP'
601 do i = 1,
size(blocknum)
604 allocate (
character(slnmnames(i)%strlen()) :: mnames)
609 mnames = slnmnames(i)
611 if (blocknum(i) /= sgid)
then
614 if (blocknum(i) == sgid + 1)
then
630 write (errmsg,
'(a,i0,a,i0,a)') &
631 'Solution group blocks are not listed consecutively. Found ', &
632 blocknum(i),
' when looking for ', sgid + 1,
'.'
641 read (fname, *, iostat=istat) mxiter
649 isgpsoln = isgpsoln + 1
653 call sgp%add_solution(isoln, sp)
656 parse_str = trim(mnames)//
' '
662 glo_mid =
ifind(model_names, words(j))
663 if (glo_mid == -1)
then
664 write (errmsg,
'(a,a)')
'Invalid model name: ', trim(words(j))
668 loc_idx = model_loc_idx(glo_mid)
669 if (loc_idx == -1)
then
679 call sp%add_model(mp)
686 isgpsoln = isgpsoln + 1
690 call sgp%add_solution(isoln, sp)
693 parse_str = trim(mnames)//
' '
699 glo_mid =
ifind(model_names, words(j))
700 if (glo_mid == -1)
then
701 write (errmsg,
'(a,a)')
'Invalid model name: ', trim(words(j))
705 loc_idx = model_loc_idx(glo_mid)
706 if (loc_idx == -1)
then
716 call sp%add_model(mp)
730 write (iout,
'(1x,a)')
'END OF SOLUTIONGROUP'
734 call store_error(
'There are no solution groups.', terminate)
745 character(len=LINELENGTH) :: errmsg
751 if (mp%idsoln == 0)
then
752 write (errmsg,
'(a,a)') &
753 'Model was not assigned to a solution: ', mp%name
775 type(
listtype),
pointer :: models_in_solution
776 integer(I4B) :: is, ie, im
786 models_in_solution => sp%get_models()
787 do im = 1, models_in_solution%Count()
789 if (ep%connects_model(mp))
then
792 call sp%add_exchange(ep)
804 character(len=*),
intent(in) :: mtype
805 character(len=*),
intent(inout) :: mname
809 character(len=LINELENGTH) :: errmsg
810 logical :: terminate = .true.
812 ilen = len_trim(mname)
814 write (errmsg,
'(a,a)')
'Invalid model name: ', trim(mname)
816 write (errmsg,
'(a,i0,a,i0)') &
817 'Name length of ', ilen,
' exceeds maximum length of ', &
822 if (mname(i:i) ==
' ')
then
823 write (errmsg,
'(a,a)')
'Invalid model name: ', trim(mname)
825 write (errmsg,
'(a)') &
826 'Model name cannot have spaces within it.'
class(baseexchangetype) function, pointer, public getbaseexchangefromlist(list, idx)
Retrieve a specific BaseExchangeType object from a list.
class(basemodeltype) function, pointer, public getbasemodelfromlist(list, idx)
subroutine, public addbasesolutiontolist(list, solution)
class(basesolutiontype) function, pointer, public getbasesolutionfromlist(list, idx)
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenmodelname
maximum length of the model name
integer(i4b), parameter lenexchangename
maximum length of the exchange name
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
integer(i4b), parameter lenbigline
maximum length of a big line
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
Disable development features in release mode.
subroutine, public dev_feature(errmsg, iunit)
Terminate if in release mode (guard development features)
class(distributedsimtype) function, pointer, public get_dsim()
Get pointer to the distributed simulation object.
This module contains the GweGweExchangeModule Module.
subroutine, public gweexchange_create(filename, name, id, m1_id, m2_id, input_mempath)
@ brief Create GWT GWT exchange
subroutine, public gwe_cr(filename, id, modelname)
Create a new groundwater energy transport model object.
subroutine, public gwfgwe_cr(filename, id, m1_id, m2_id)
Create a new GWF to GWE exchange object.
This module contains the GwfGwfExchangeModule Module.
subroutine, public gwfexchange_create(filename, name, id, m1_id, m2_id, input_mempath)
@ brief Create GWF GWF exchange
subroutine, public gwfgwt_cr(filename, id, m1_id, m2_id)
Create a new GWF to GWT exchange object.
subroutine, public gwf_cr(filename, id, modelname)
Create a new groundwater flow model object.
subroutine, public gwfprt_cr(filename, id, m1id, m2id)
Create a new GWF to PRT exchange object.
This module contains the GwtGwtExchangeModule Module.
subroutine, public gwtexchange_create(filename, name, id, m1_id, m2_id, input_mempath)
@ brief Create GWT GWT exchange
subroutine, public gwt_cr(filename, id, modelname)
Create a new groundwater transport model object.
This module defines variable data types.
subroutine, public write_kindinfo(iout)
Write variable data types.
type(listtype), public basemodellist
type(listtype), public baseexchangelist
type(listtype), public solutiongrouplist
type(listtype), public basesolutionlist
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public mem_set_print_option(iout, keyword, error_msg)
Set the memory print option.
class(numericalmodeltype) function, pointer, public getnumericalmodelfromlist(list, idx)
subroutine, public prt_cr(filename, id, modelname)
Create a new particle tracking model object.
This module contains simulation methods.
subroutine, public store_warning(msg, substring)
Store warning message.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public maxerrors(imax)
Set the maximum number of errors to be stored.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
subroutine models_create()
Set the models to be used for the simulation.
subroutine check_model_assignment()
Check for dangling models, and break with error when found.
subroutine, public simulation_da()
Deallocate simulation variables.
subroutine options_create()
Set the simulation options.
subroutine check_model_name(mtype, mname)
Check that the model name is valid.
subroutine source_simulation_nam()
Source the simulation name file.
subroutine solution_groups_create()
Set the solution_groups to be used for the simulation.
subroutine timing_create()
Set the timing module to be used for the simulation.
subroutine exchanges_create()
Set the exchanges to be used for the simulation.
subroutine assign_exchanges()
Assign exchanges to solutions.
subroutine solution_group_check(sgp, sgid, isgpsoln)
Check a solution_group to be used for the simulation.
subroutine, public simulation_cr()
Read the simulation name file and initialize the models, exchanges.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
integer(i4b) isimcheck
simulation input check flag (1) to check input, (0) to ignore checks
integer(i4b) isimcontinue
simulation continue flag (1) to continue if isimcnvg = 0, (0) to terminate
character(len=linelength) simulation_mode
integer(i4b), dimension(:), allocatable model_loc_idx
equals the local index into the basemodel list (-1 when not available)
integer(i4b) iout
file unit number for simulation output
character(len=lenmodelname), dimension(:), allocatable model_names
all model names in the (global) simulation
class(basesolutiontype) function, pointer, public create_ims_solution(sim_mode, filename, sol_id)
Create an IMS solution of type NumericalSolution for serial runs or its sub-type ParallelSolution for...
class(basesolutiontype) function, pointer, public create_ems_solution(sim_mode, filename, sol_id)
Create an EMS solution of type ExplicitSolution for serial runs or its sub-type ParallelSolution for.
subroutine, public solutiongroup_create(sgp, id)
subroutine, public addsolutiongrouptolist(list, solutiongroup)
This module contains the SwfGwfExchangeModule Module.
subroutine, public swfgwf_cr(filename, name, id, m1_id, m2_id, input_mempath)
@ brief Create SWF GWF exchange
Stream Network Flow (SWF) Module.
subroutine, public swf_cr(filename, id, modelname)
Create a new stream network flow model object.
subroutine, public tdis_cr(fname, inmempath)
Create temporal discretization.
This module contains version information.
subroutine write_listfile_header(iout, cmodel_type, write_sys_command, write_kind_info)
@ brief Write program header
subroutine, public add_virtual_gwe_exchange(name, exchange_id, model1_id, model2_id)
Add a virtual GWE-GWE exchange to the simulation.
subroutine, public add_virtual_gwe_model(model_id, model_name, model)
subroutine, public add_virtual_gwf_exchange(name, exchange_id, model1_id, model2_id)
Add a virtual GWF-GWF exchange to the simulation.
subroutine, public add_virtual_gwf_model(model_id, model_name, model)
Add virtual GWF model.
subroutine, public add_virtual_gwt_exchange(name, exchange_id, model1_id, model2_id)
Add a virtual GWT-GWT exchange to the simulation.
subroutine, public add_virtual_gwt_model(model_id, model_name, model)
Highest level model type. All models extend this parent type.
This class is used to store a single deferred-length character string. It was designed to work in an ...
A generic heterogeneous doubly-linked list.