29 character(len=LENFTYPE) ::
ftype =
'SPC'
30 character(len=LENPACKAGENAME) ::
text =
'STRESS PACK COMP'
41 character(len=LENMODELNAME) :: name_model =
''
42 character(len=LENPACKAGENAME) :: packname =
''
43 character(len=LENPACKAGENAME) :: packnameflow =
''
44 character(len=LENVARNAME) :: depvarname =
''
45 character(len=LENMEMPATH) :: memorypath =
''
46 integer(I4B),
pointer :: id => null()
47 integer(I4B),
pointer :: inunit => null()
48 integer(I4B),
pointer :: iout => null()
49 integer(I4B),
pointer :: maxbound => null()
50 integer(I4B),
pointer :: ionper => null()
51 integer(I4B),
pointer :: lastonper => null()
52 integer(I4B),
pointer :: iprpak => null()
53 logical(LGP),
pointer :: readasarrays => null()
54 real(dp),
dimension(:),
pointer,
contiguous :: dblvec => null()
89 subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow, &
94 integer(I4B),
intent(in) :: id
95 integer(I4B),
intent(in) :: inunit
96 integer(I4B),
intent(in) :: iout
97 character(len=*),
intent(in) :: name_model
98 character(len=*),
intent(in) :: packNameflow
99 character(len=*),
intent(in) :: dvn
103 write (this%packName,
'(a, i0)')
'SPC'//
'-', id
104 this%name_model = name_model
108 call this%allocate_scalars()
114 this%packNameFlow = packnameflow
115 this%depvarname = dvn
121 call this%parser%Initialize(this%inunit, this%iout)
125 call tasmanager_cr(this%TasManager, dis, name_model, this%iout)
128 call this%read_options()
131 if (this%readasarrays)
then
132 this%maxbound = this%dis%get_ncpl()
134 call this%read_dimensions()
138 call this%allocate_arrays()
141 call this%tsmanager%tsmanager_df()
142 call this%tasmanager%tasmanager_df()
158 call mem_allocate(this%inunit,
'INUNIT', this%memoryPath)
160 call mem_allocate(this%maxbound,
'MAXBOUND', this%memoryPath)
161 call mem_allocate(this%ionper,
'IONPER', this%memoryPath)
162 call mem_allocate(this%lastonper,
'LASTONPER', this%memoryPath)
163 call mem_allocate(this%iprpak,
'IPRPAK', this%memoryPath)
164 call mem_allocate(this%readasarrays,
'READASARRAYS', this%memoryPath)
167 allocate (this%TsManager)
168 allocate (this%TasManager)
178 this%readasarrays = .false.
191 character(len=LINELENGTH) :: keyword, fname
193 logical :: isfound, endOfBlock
195 character(len=*),
parameter :: fmtiprpak = &
196 &
"(4x,'SPC INFORMATION WILL BE PRINTED TO LISTING FILE.')"
197 character(len=*),
parameter :: fmtreadasarrays = &
198 "(4x,'SPC INFORMATION WILL BE READ AS ARRAYS RATHER THAN IN LIST &
200 character(len=*),
parameter :: fmtts = &
201 &
"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
202 character(len=*),
parameter :: fmttas = &
203 &
"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
206 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
207 supportopenclose=.true.)
211 write (this%iout,
'(1x,a)')
'PROCESSING SPC OPTIONS'
213 call this%parser%GetNextLine(endofblock)
215 call this%parser%GetStringCaps(keyword)
216 select case (keyword)
219 write (this%iout, fmtiprpak)
220 case (
'READASARRAYS')
221 this%readasarrays = .true.
222 write (this%iout, fmtreadasarrays)
224 call this%parser%GetStringCaps(keyword)
225 if (trim(adjustl(keyword)) /=
'FILEIN')
then
226 errmsg =
'TS6 keyword must be followed by "FILEIN" '// &
230 call this%parser%GetString(fname)
231 write (this%iout, fmtts) trim(fname)
232 call this%TsManager%add_tsfile(fname, this%inunit)
234 call this%parser%GetStringCaps(keyword)
235 if (trim(adjustl(keyword)) /=
'FILEIN')
then
236 errmsg =
'TAS6 keyword must be followed by "FILEIN" '// &
239 call this%parser%StoreErrorUnit()
241 call this%parser%GetString(fname)
242 write (this%iout, fmttas) trim(fname)
243 call this%TasManager%add_tasfile(fname)
245 write (
errmsg,
'(a,a)')
'Unknown SPC option: ', trim(keyword)
247 call this%parser%StoreErrorUnit()
250 write (this%iout,
'(1x,a)')
'END OF SPC OPTIONS'
263 character(len=LINELENGTH) :: keyword
264 logical(LGP) :: isfound
265 logical(LGP) :: endOfBlock
269 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
270 supportopenclose=.true.)
274 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(
text))// &
277 call this%parser%GetNextLine(endofblock)
279 call this%parser%GetStringCaps(keyword)
280 select case (keyword)
282 this%maxbound = this%parser%GetInteger()
283 write (this%iout,
'(4x,a,i7)')
'MAXBOUND = ', this%maxbound
285 write (
errmsg,
'(a,3(1x,a))') &
286 'Unknown', trim(
text),
'dimension:', trim(keyword)
291 write (this%iout,
'(1x,a)')
'END OF '//trim(adjustl(
text))//
' DIMENSIONS'
293 call store_error(
'Required DIMENSIONS block not found.')
294 call this%parser%StoreErrorUnit()
298 if (this%maxbound <= 0)
then
299 write (
errmsg,
'(a)')
'MAXBOUND must be an integer greater than zero.'
305 call this%parser%StoreErrorUnit()
323 call mem_allocate(this%dblvec, this%maxbound,
'DBLVEC', this%memoryPath)
326 do i = 1, this%maxbound
327 this%dblvec(i) =
dzero
336 function get_value(this, ientry, nbound_flow)
result(value)
338 integer(I4B),
intent(in) :: ientry
339 integer(I4B),
intent(in) :: nbound_flow
342 if (this%readasarrays)
then
353 if (nbound_flow == this%maxbound)
then
356 value = this%dblvec(ientry)
366 nu = this%dis%get_nodeuser(ientry)
367 value = this%dblvec(nu)
370 value = this%dblvec(ientry)
386 character(len=LINELENGTH) :: line
390 character(len=*),
parameter :: fmtblkerr = &
391 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
392 character(len=*),
parameter :: fmtlsp = &
393 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
397 if (this%inunit == 0)
return
400 if (this%ionper <
kper)
then
403 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
404 supportopenclose=.true., &
405 blockrequired=.false.)
409 call this%read_check_ionper()
415 this%ionper =
nper + 1
418 call this%parser%GetCurrentLine(line)
419 write (
errmsg, fmtblkerr) adjustl(trim(line))
426 if (this%ionper ==
kper)
then
433 call this%TasManager%Reset(this%packName)
434 if (this%readasarrays)
then
435 call this%spc_rp_array(line)
437 call this%spc_rp_list()
442 write (this%iout, fmtlsp) trim(
ftype)
447 call this%parser%StoreErrorUnit()
462 character(len=LINELENGTH) :: line
463 character(len=LINELENGTH) :: title
464 character(len=LINELENGTH) :: tabletext
465 logical :: endOfBlock
470 if (this%iprpak /= 0)
then
473 title = trim(adjustl(
text))//
' PACKAGE ('// &
474 'SPC'//
') DATA FOR PERIOD'
475 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
477 call this%inputtab%table_df(1, 3, this%iout, finalize=.false.)
479 call this%inputtab%initialize_column(tabletext, 10, alignment=
tabcenter)
480 tabletext =
'DATA TYPE'
481 call this%inputtab%initialize_column(tabletext, 20, alignment=
tableft)
482 write (tabletext,
'(a,1x,i6)')
'VALUE'
483 call this%inputtab%initialize_column(tabletext, 15, alignment=
tabcenter)
488 call this%parser%GetNextLine(endofblock)
491 ival = this%parser%GetInteger()
492 if (ival < 1 .or. ival > this%maxbound)
then
493 write (
errmsg,
'(2(a,1x),i0,a)') &
494 'IVAL must be greater than 0 and', &
495 'less than or equal to ', this%maxbound,
'.'
501 call this%set_value(ival)
504 if (this%iprpak /= 0)
then
505 call this%parser%GetCurrentLine(line)
506 call this%inputtab%line_to_columns(line)
511 if (this%iprpak /= 0)
then
512 call this%inputtab%finalize_table()
527 character(len=LINELENGTH),
intent(inout) :: line
530 integer(I4B) :: ncolbnd
531 integer(I4B) :: jauxcol, ivarsread
532 integer(I4B),
dimension(:),
allocatable,
target :: nodelist
533 character(len=LENTIMESERIESNAME) :: tasName
534 character(len=LENANAME) :: aname
535 character(len=LINELENGTH) :: keyword
536 logical :: endOfBlock
537 logical :: convertFlux
541 real(DP),
dimension(:),
pointer :: bndArrayPtr => null()
549 allocate (nodelist(this%maxbound))
550 do n = 1,
size(nodelist)
556 call this%parser%GetNextLine(endofblock)
558 call this%parser%GetStringCaps(keyword)
561 select case (keyword)
562 case (
'CONCENTRATION',
'TEMPERATURE')
566 call this%parser%GetStringCaps(keyword)
567 if (keyword ==
'TIMEARRAYSERIES')
then
569 call this%parser%GetStringCaps(tasname)
570 bndarrayptr => this%dblvec(:)
573 convertflux = .false.
574 call this%TasManager%MakeTasLink(this%packName, bndarrayptr, &
575 this%iprpak, tasname, &
577 convertflux, nodelist, &
578 this%parser%iuactive)
582 call this%dis%read_layer_array(nodelist, this%dblvec, ncolbnd, &
583 this%maxbound, 1, aname, &
584 this%parser%iuactive, this%iout)
588 call store_error(
'Looking for component name, either CONCENTRATION &
589 &or TEMPERATURE. Found: '//trim(line))
590 call this%parser%StoreErrorUnit()
602 subroutine spc_ad(this, nbound_flowpack, budtxt)
606 integer(I4B),
intent(in) :: nbound_flowpack
607 character(len=*),
intent(in) :: budtxt
611 call this%TsManager%ad()
612 call this%TasManager%ad()
615 call this%check_flow_package(nbound_flowpack, budtxt)
643 call this%TsManager%da()
644 deallocate (this%TsManager)
645 nullify (this%TsManager)
663 this%lastonper = this%ionper
664 this%ionper = this%parser%GetInteger()
667 if (this%ionper <= this%lastonper)
then
668 write (
errmsg,
'(a, i0, a, i0, a, i0, a)') &
669 'Error in stress period ',
kper, &
670 '. Period numbers not increasing. Found ', this%ionper, &
671 ' but last period block was assigned ', this%lastonper,
'.'
673 call this%parser%StoreErrorUnit()
688 integer(I4B),
intent(in) :: ival
690 character(len=LINELENGTH) :: keyword
692 real(DP),
pointer :: bndElem => null()
695 call this%parser%GetStringCaps(keyword)
696 select case (keyword)
697 case (
'CONCENTRATION',
'TEMPERATURE')
698 call this%parser%GetString(
text)
700 bndelem => this%dblvec(ival)
702 'BND', this%tsManager, this%iprpak, &
718 integer(I4B),
intent(in) :: nbound_flowpack
719 character(len=*),
intent(in) :: budtxt
723 if (this%maxbound < nbound_flowpack)
then
724 write (
errmsg,
'(a, a, a, i0, a, i0, a)') &
725 'The SPC Package corresponding to flow package ', &
726 trim(this%packNameFlow), &
727 ' has MAXBOUND set less than the number of boundaries &
728 &active in this package. Found MAXBOUND equal ', &
730 ' and number of flow boundaries (NBOUND) equal ', &
732 '. Increase MAXBOUND in the SPC input file for this package.'
734 call this%parser%StoreErrorUnit()
739 select case (trim(adjustl(budtxt)))
741 if (.not. this%readasarrays)
then
742 write (
errmsg,
'(a, a, a)') &
743 'Array-based recharge must be used with array-based stress package &
744 &concentrations. GWF Package ', trim(this%packNameFlow),
' is being &
745 &used with list-based SPC6 input. Use array-based SPC6 input instead.'
747 call this%parser%StoreErrorUnit()
750 if (.not. this%readasarrays)
then
751 write (
errmsg,
'(a, a, a)') &
752 'Array-based evapotranspiration must be used with array-based stress &
753 &package concentrations. GWF Package ', trim(this%packNameFlow), &
754 &
' is being used with list-based SPC6 input. Use array-based SPC6 &
757 call this%parser%StoreErrorUnit()
760 if (this%readasarrays)
then
761 write (
errmsg,
'(a, a, a)') &
762 'List-based packages must be used with list-based stress &
763 &package concentrations. GWF Package ', trim(this%packNameFlow), &
764 &
' is being used with array-based SPC6 input. Use list-based SPC6 &
767 call this%parser%StoreErrorUnit()
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ tabcenter
centered table column
@ tableft
left justified table column
integer(i4b), parameter lenmodelname
maximum length of the model name
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
integer(i4b), parameter lenaname
maximum length of the header text for an array
integer(i4b), parameter lenvarname
maximum length of a variable name
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
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.
integer(i4b) function, public count_errors()
Return number of errors.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
integer(i4b), pointer, public kper
current stress period number
integer(i4b), pointer, public nper
number of stress period
subroutine, public tasmanager_cr(this, dis, modelname, iout)
Create the time-array series manager.
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
subroutine, public tsmanager_cr(this, iout, removeTsLinksOnCompletion, extendTsToEndOfSimulation)
Create the tsmanager.
This module contains the TspSpc Module.
subroutine spc_ad(this, nbound_flowpack, budtxt)
@ brief Advance
subroutine set_value(this, ival)
@ brief Set the data value from the input file
subroutine spc_da(this)
@ brief Deallocate variables
character(len=lenftype) ftype
subroutine spc_rp_list(this)
@ brief spc_rp_list
subroutine check_flow_package(this, nbound_flowpack, budtxt)
@ brief check_flow_package
subroutine spc_rp(this)
@ brief Read and prepare
real(dp) function get_value(this, ientry, nbound_flow)
@ brief Get the data value from this package
subroutine allocate_scalars(this)
@ brief Allocate package scalars
subroutine read_check_ionper(this)
@ brief Check ionper
subroutine allocate_arrays(this)
@ brief Allocate package arrays
subroutine read_options(this)
@ brief Read options for package
subroutine spc_rp_array(this, line)
@ brief spc_rp_array
subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow, dvn)
@ brief Initialize the SPC type
character(len=lenpackagename) text
subroutine read_dimensions(this)
@ brief Read dimensions for package
Derived type for managing SPC input.