17 character(len=LENMEMPATH) :: memorypath
18 character(len=LENMODELNAME),
pointer :: name_model => null()
19 integer(I4B),
pointer :: inunit => null()
20 integer(I4B),
pointer :: iout => null()
21 integer(I4B),
pointer :: ibudcsv => null()
22 integer(I4B),
pointer :: iperoc => null()
23 integer(I4B),
pointer :: iocrep => null()
42 subroutine oc_cr(oc, name_model, inunit, iout)
44 character(len=*),
intent(in) :: name_model
45 integer(I4B),
intent(in) :: inunit
46 integer(I4B),
intent(in) :: iout
49 call oc%allocate_scalars(name_model)
52 call oc%parser%Initialize(inunit, iout)
69 integer(I4B) :: ierr, ival, ipos
70 logical :: isfound, found, endOfBlock
71 character(len=:),
allocatable :: line
72 character(len=LINELENGTH) :: ermsg, keyword1, keyword2
73 character(len=LINELENGTH) :: printsave
76 character(len=*),
parameter :: fmtboc = &
77 &
"(1X,/1X,'BEGIN READING OUTPUT CONTROL FOR STRESS PERIOD ',I0)"
78 character(len=*),
parameter :: fmteoc = &
79 &
"(/,1X,'END READING OUTPUT CONTROL FOR STRESS PERIOD ',I0)"
80 character(len=*),
parameter :: fmterr = &
81 &
"(' ERROR READING OUTPUT CONTROL PERIOD BLOCK: ')"
82 character(len=*),
parameter :: fmtroc = &
83 "(1X,/1X,'OUTPUT CONTROL FOR STRESS PERIOD ',I0, &
84 &' IS REPEATED USING SETTINGS FROM A PREVIOUS STRESS PERIOD.')"
85 character(len=*),
parameter :: fmtpererr = &
86 &
"(1x,'CURRENT STRESS PERIOD GREATER THAN PERIOD IN OUTPUT CONTROL.')"
87 character(len=*),
parameter :: fmtpererr2 = &
88 &
"(1x,'CURRENT STRESS PERIOD: ',I0,' SPECIFIED STRESS PERIOD: ',I0)"
91 if (this%iperoc <
kper)
then
94 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
95 supportopenclose=.true., &
96 blockrequired=.false.)
100 this%iperoc =
nper + 1
101 write (this%iout,
'(/,1x,a)')
'END OF FILE DETECTED IN OUTPUT CONTROL.'
102 write (this%iout,
'(1x,a)')
'CURRENT OUTPUT CONTROL SETTINGS WILL BE '
103 write (this%iout,
'(1x,a)')
'REPEATED UNTIL THE END OF THE SIMULATION.'
107 ival = this%parser%GetInteger()
110 if (ival <= 0 .or. ival >
nper)
then
111 write (ermsg,
'(a,i0)')
'PERIOD NOT VALID IN OUTPUT CONTROL: ', ival
113 write (ermsg,
'(a, a)')
'LINE: ', trim(adjustl(line))
118 if (ival <
kper)
then
119 write (ermsg, fmtpererr)
121 write (ermsg, fmtpererr2)
kper, ival
123 write (ermsg,
'(a, a)')
'LINE: ', trim(adjustl(line))
129 call this%parser%StoreErrorUnit()
136 if (this%iperoc ==
kper)
then
139 do ipos = 1,
size(this%ocds)
140 ocdobjptr => this%ocds(ipos)
141 call ocdobjptr%psm%init()
145 write (this%iout, fmtboc) this%iperoc
151 call this%parser%GetNextLine(endofblock)
153 call this%parser%GetStringCaps(keyword1)
158 call this%parser%GetStringCaps(keyword2)
164 do ipos = 1,
size(this%ocds)
165 ocdobjptr => this%ocds(ipos)
166 if (keyword2 == trim(ocdobjptr%cname))
then
171 if (.not. found)
then
172 call this%parser%GetCurrentLine(line)
173 write (ermsg, fmterr)
175 call store_error(
'UNRECOGNIZED KEYWORD: '//keyword2)
177 call this%parser%StoreErrorUnit()
179 call this%parser%GetRemainingLine(line)
180 call ocdobjptr%psm%read(trim(printsave)//
' '//line, &
182 call ocdobjptr%ocd_rp_check(this%parser%iuactive)
184 write (this%iout, fmteoc) this%iperoc
189 write (this%iout, fmtroc)
kper
203 integer(I4B),
intent(inout) :: ipflg
212 do ipos = 1,
size(this%ocds)
213 ocdobjptr => this%ocds(ipos)
231 do i = 1,
size(this%ocds)
232 call this%ocds(i)%ocd_da()
234 deallocate (this%ocds)
236 deallocate (this%name_model)
251 character(len=*),
intent(in) :: name_model
255 allocate (this%name_model)
256 call mem_allocate(this%inunit,
'INUNIT', this%memoryPath)
258 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
259 call mem_allocate(this%iperoc,
'IPEROC', this%memoryPath)
260 call mem_allocate(this%iocrep,
'IOCREP', this%memoryPath)
262 this%name_model = name_model
278 character(len=LINELENGTH) :: keyword
279 character(len=LINELENGTH) :: keyword2
280 character(len=LINELENGTH) :: fname
281 character(len=:),
allocatable :: line
284 logical :: isfound, found, endOfBlock
288 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
289 supportopenclose=.true., blockrequired=.false.)
293 write (this%iout,
'(/,1x,a,/)')
'PROCESSING OC OPTIONS'
295 call this%parser%GetNextLine(endofblock)
297 call this%parser%GetStringCaps(keyword)
299 if (keyword ==
'BUDGETCSV')
then
300 call this%parser%GetStringCaps(keyword2)
301 if (keyword2 /=
'FILEOUT')
then
302 errmsg =
"BUDGETCSV must be followed by FILEOUT and then budget &
303 &csv file name. Found '"//trim(keyword2)//
"'."
305 call this%parser%StoreErrorUnit()
307 call this%parser%GetString(fname)
309 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
310 filstat_opt=
'REPLACE')
314 if (.not. found)
then
315 do ipos = 1,
size(this%ocds)
316 ocdobjptr => this%ocds(ipos)
317 if (keyword == trim(ocdobjptr%cname))
then
322 if (.not. found)
then
323 errmsg =
"UNKNOWN OC OPTION '"//trim(keyword)//
"'."
325 call this%parser%StoreErrorUnit()
327 call this%parser%GetRemainingLine(line)
328 call ocdobjptr%set_option(line, this%parser%iuactive, this%iout)
331 write (this%iout,
'(1x,a)')
'END OF OC OPTIONS'
341 character(len=*),
intent(in) :: cname
349 do ipos = 1,
size(this%ocds)
350 ocdobjptr => this%ocds(ipos)
351 if (cname == trim(ocdobjptr%cname))
then
367 character(len=*),
intent(in) :: cname
375 do ipos = 1,
size(this%ocds)
376 ocdobjptr => this%ocds(ipos)
377 if (cname == trim(ocdobjptr%cname))
then
394 character(len=*),
intent(in) :: cname
402 do ipos = 1,
size(this%ocds)
403 ocdobjptr => this%ocds(ipos)
404 if (cname == trim(ocdobjptr%cname))
then
419 integer(I4B) :: iprint_flag
422 character(len=*),
intent(in) :: cname
423 integer(I4B),
intent(in) :: icnvg
424 logical,
intent(in) :: endofperiod
431 if (this%oc_print(cname)) iprint_flag = 1
435 if (icnvg == 0) iprint_flag = 1
439 if (endofperiod) iprint_flag = 1
This module contains block parser methods.
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 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
Output control data module.
subroutine, public ocd_cr(ocdobj)
@ brief Create a new output control data type.
subroutine, public oc_cr(oc, name_model, inunit, iout)
Create a new output control object.
subroutine oc_rp(this)
@ brief Read period block options and prepare the output control type.
logical function oc_save(this, cname)
@ brief Determine if it is time to save.
logical function oc_print(this, cname)
@ brief Determine if it is time to print.
subroutine oc_df(this)
@ brief Define the output control type. Placeholder routine.
integer(i4b) function set_print_flag(this, cname, icnvg, endofperiod)
@ brief Set the print flag based on convergence and other parameters
integer(i4b) function oc_save_unit(this, cname)
@ brief Determine unit number for saving
subroutine oc_ot(this, ipflg)
@ brief Write output.
subroutine read_options(this)
@ brief Read the output control options block
subroutine allocate(this, name_model)
@ brief Allocate variables for the output control object
subroutine oc_da(this)
@ brief Deallocate method for OutputControlType
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.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
integer(i4b) isimcontinue
simulation continue flag (1) to continue if isimcnvg = 0, (0) to terminate
logical(lgp), pointer, public endofperiod
flag indicating end of stress period
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
integer(i4b), pointer, public nper
number of stress period
Output control data type.
@ brief Controls model output. Overridden for each model type.