30 character(len=LENPACKAGETYPE) :: pkgtype
32 character(len=LENCOMPONENTNAME) :: subcomponent_type
34 character(len=LINELENGTH),
dimension(:),
allocatable :: filenames
35 character(len=LENPACKAGENAME),
dimension(:),
allocatable :: pkgnames
36 character(len=LENMEMPATH),
dimension(:),
allocatable :: mempaths
37 integer(I4B),
dimension(:),
allocatable :: inunits
54 character(len=LENPACKAGETYPE) :: modeltype
55 character(len=LINELENGTH) :: modelfname
56 character(len=LENMODELNAME) :: modelname
58 character(len=LENCOMPONENTNAME) :: component_type
60 character(len=LENMEMPATH) :: input_mempath
61 character(len=LENMEMPATH) :: model_mempath
64 pointer :: pkgtypes => null()
66 pointer :: pkgnames => null()
68 pointer :: mempaths => null()
69 integer(I4B),
dimension(:),
contiguous, &
70 pointer :: inunits => null()
74 integer(I4B) :: niunit
75 character(len=LENPACKAGETYPE),
dimension(:),
allocatable :: cunit
98 character(len=LENCOMPONENTNAME),
intent(in) :: mtype_component
99 character(len=LENCOMPONENTNAME),
intent(in) :: ptype_component
100 character(len=LENFTYPE),
intent(in) :: pkgtype
102 logical(LGP) :: multi_pkg
126 character(len=*),
intent(in) :: modeltype
127 character(len=*),
intent(in) :: modelname
128 character(len=*),
intent(in) :: pkgtype
132 this%pkgtype = pkgtype
137 allocate (this%filenames(0))
138 allocate (this%pkgnames(0))
139 allocate (this%mempaths(0))
140 allocate (this%inunits(0))
148 subroutine pkgtype_add(this, modelname, mtype_component, filetype, &
149 filename, pkgname, iout)
159 character(len=*),
intent(in) :: modelname
160 character(len=*),
intent(in) :: mtype_component
161 character(len=*),
intent(in) :: filetype
162 character(len=*),
intent(in) :: filename
163 character(len=*),
intent(in) :: pkgname
164 integer(I4B),
intent(in) :: iout
166 character(len=LENPACKAGENAME) :: sc_name, pname
167 character(len=LENMEMPATH) :: mempath
168 character(len=LINELENGTH),
pointer :: cstr
177 this%pnum = this%pnum + 1
178 this%filenames(this%pnum) = filename
179 this%pkgnames(this%pnum) = pkgname
180 this%inunits(this%pnum) = 0
183 if (this%pkgnames(this%pnum) ==
'')
then
184 write (pname,
'(a,i0)') trim(this%subcomponent_type)//
'-', this%pnum
185 this%pkgnames(this%pnum) = pname
193 this%pkgnames(this%pnum))
196 this%mempaths(this%pnum) = &
207 this%mempaths(this%pnum) =
''
223 deallocate (this%filenames)
224 deallocate (this%pkgnames)
225 deallocate (this%inunits)
226 deallocate (this%mempaths)
243 character(len=*),
intent(in) :: modeltype
244 character(len=*),
intent(in) :: modelfname
245 character(len=*),
intent(in) :: modelname
246 integer(I4B),
intent(in) :: iout
250 this%modeltype = modeltype
251 this%modelfname = modelfname
252 this%modelname = modelname
271 call mem_allocate(this%inunits, 0,
'INUNITS', this%model_mempath)
290 integer(I4B),
dimension(:),
allocatable :: cunit_idxs, indx
291 character(len=LENPACKAGETYPE) :: ftype
293 logical(LGP) :: found
296 allocate (cunit_idxs(0))
299 do n = 1,
size(ftypes)
306 do m = 1, this%niunit
307 if (this%cunit(m) == ftype)
then
312 if (any(cunit_idxs == m))
then
316 cunit_idxs(
size(cunit_idxs)) = m
325 if (.not. found)
then
326 write (errmsg,
'(a,a,a,a,a)')
'Model package type not supported &
327 &[model=', trim(this%modelname),
', type=', &
335 allocate (this%pkglist(
size(cunit_idxs)))
338 allocate (indx(
size(cunit_idxs)))
339 call qsort(indx, cunit_idxs)
342 do n = 1,
size(cunit_idxs)
343 call this%pkglist(n)%create(this%modeltype, this%modelname, &
344 this%cunit(cunit_idxs(n)))
348 deallocate (cunit_idxs)
361 character(len=*),
intent(in) :: pkgtype
362 character(len=*),
intent(in) :: filename
363 character(len=*),
intent(in) :: pkgname
369 do n = 1,
size(this%pkglist)
370 pkg = this%pkglist(n)
371 if (pkg%pkgtype == pkgtype)
then
372 call this%pkglist(n)%add(this%modelname, this%component_type, &
373 pkgtype, filename, pkgname, this%iout)
396 character(len=LINELENGTH) :: ftype, fname, pname
400 call mem_setptr(ftypes,
'FTYPE', this%input_mempath)
401 call mem_setptr(fnames,
'FNAME', this%input_mempath)
402 call mem_setptr(pnames,
'PNAME', this%input_mempath)
405 call this%create(ftypes)
408 do n = 1,
size(ftypes)
416 call this%add(ftype, fname, pname)
439 do n = 1,
size(this%pkglist)
442 this%pkglist(n)%subcomponent_type, &
443 this%pkglist(n)%pkgtype))
then
447 if (this%pkglist(n)%pnum > 1)
then
448 write (errmsg,
'(a,a,a,a,a)') &
449 'Multiple instances specified for model base package type &
450 &[model=', trim(this%modelname),
', type=', &
451 trim(this%pkglist(n)%pkgtype),
'].'
458 pnum = pnum + this%pkglist(n)%pnum
473 integer(I4B) :: n, m, idx
480 pnum = this%pkgcount()
489 call mem_reallocate(this%inunits, pnum,
'INUNITS', this%model_mempath)
492 do n = 1,
size(this%pkglist)
494 do m = 1, this%pkglist(n)%pnum
498 this%pkgtypes(idx) = trim(this%pkglist(n)%pkgtype)
500 this%pkgnames(idx) = trim(this%pkglist(n)%pkgnames(m))
502 this%mempaths(idx) = trim(this%pkglist(n)%mempaths(m))
504 this%inunits(idx) = this%pkglist(n)%inunits(m)
522 do n = 1,
size(this%pkglist)
523 call this%pkglist(n)%destroy()
526 deallocate (this%pkglist)
527 deallocate (this%cunit)
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lencomponentname
maximum length of a component name
integer(i4b), parameter lenmodelname
maximum length of the model name
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
integer(i4b), parameter lenmempath
maximum length of the memory path
logical function, public idm_integrated(component, subcomponent)
logical function, public idm_multi_package(component, subcomponent)
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
integer(i4b) iout
file unit number for simulation output
This module contains the SourceCommonModule.
character(len=lencomponentname) function, public idm_subcomponent_type(component, subcomponent)
component from package or model type
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
This class is used to store a single deferred-length character string. It was designed to work in an ...