MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
OutputControl.f90
Go to the documentation of this file.
1 !> @brief Model output control.
3 
4  use kindmodule, only: dp, i4b
6  use simvariablesmodule, only: errmsg
10 
11  implicit none
12  private
13  public outputcontroltype, oc_cr
14 
15  !> @ brief Controls model output. Overridden for each model type.
17  character(len=LENMEMPATH) :: memorypath !< path to data stored in the memory manager
18  character(len=LENMODELNAME), pointer :: name_model => null() !< name of the model
19  integer(I4B), pointer :: inunit => null() !< unit number for input file
20  integer(I4B), pointer :: iout => null() !< unit number for output file
21  integer(I4B), pointer :: ibudcsv => null() !< unit number for budget csv output file
22  integer(I4B), pointer :: iperoc => null() !< stress period number for next output control
23  integer(I4B), pointer :: iocrep => null() !< output control repeat flag (period 0 step 0)
24  type(outputcontroldatatype), pointer, contiguous :: ocds(:) => null() !< output control objects
25  type(blockparsertype) :: parser
26  contains
27  procedure :: oc_df
28  procedure :: oc_rp
29  procedure :: oc_ot
30  procedure :: oc_da
31  procedure :: allocate_scalars => allocate
32  procedure :: read_options
33  procedure :: oc_save
34  procedure :: oc_print
35  procedure :: oc_save_unit
36  procedure :: set_print_flag
37  end type outputcontroltype
38 
39 contains
40 
41  !> @brief Create a new output control object.
42  subroutine oc_cr(oc, name_model, inunit, iout)
43  type(outputcontroltype), pointer :: oc !< OutputControlType object
44  character(len=*), intent(in) :: name_model !< name of the model
45  integer(I4B), intent(in) :: inunit !< unit number for input
46  integer(I4B), intent(in) :: iout !< unit number for output
47 
48  allocate (oc)
49  call oc%allocate_scalars(name_model)
50  oc%inunit = inunit
51  oc%iout = iout
52  call oc%parser%Initialize(inunit, iout)
53  end subroutine oc_cr
54 
55  !> @ brief Define the output control type. Placeholder routine.
56  subroutine oc_df(this)
57  class(outputcontroltype) :: this !< this instance
58  end subroutine oc_df
59 
60  !> @ brief Read period block options and prepare the output control type.
61  subroutine oc_rp(this)
62  ! modules
63  use tdismodule, only: kper, nper
64  use constantsmodule, only: linelength
66  ! dummy
67  class(outputcontroltype) :: this !< this instance
68  ! local
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
74  class(outputcontroldatatype), pointer :: ocdobjptr
75  ! formats
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)"
89 
90  ! Read next block header if kper greater than last one read
91  if (this%iperoc < kper) then
92 
93  ! Get period block
94  call this%parser%GetBlock('PERIOD', isfound, ierr, &
95  supportopenclose=.true., &
96  blockrequired=.false.)
97 
98  ! If end of file, set iperoc past kper, else parse line
99  if (ierr < 0) then
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.'
104  else
105 
106  ! Read period number
107  ival = this%parser%GetInteger()
108 
109  ! Check to see if this is a valid kper
110  if (ival <= 0 .or. ival > nper) then
111  write (ermsg, '(a,i0)') 'PERIOD NOT VALID IN OUTPUT CONTROL: ', ival
112  call store_error(ermsg)
113  write (ermsg, '(a, a)') 'LINE: ', trim(adjustl(line))
114  call store_error(ermsg)
115  end if
116 
117  ! Check to see if specified is less than kper
118  if (ival < kper) then
119  write (ermsg, fmtpererr)
120  call store_error(ermsg)
121  write (ermsg, fmtpererr2) kper, ival
122  call store_error(ermsg)
123  write (ermsg, '(a, a)') 'LINE: ', trim(adjustl(line))
124  call store_error(ermsg)
125  end if
126 
127  ! Stop or set iperoc and continue
128  if (count_errors() > 0) then
129  call this%parser%StoreErrorUnit()
130  end if
131  this%iperoc = ival
132  end if
133  end if
134 
135  ! Read the stress period block
136  if (this%iperoc == kper) then
137 
138  ! Clear io flags
139  do ipos = 1, size(this%ocds)
140  ocdobjptr => this%ocds(ipos)
141  call ocdobjptr%psm%init()
142  end do
143 
144  ! Output control time step matches simulation time step.
145  write (this%iout, fmtboc) this%iperoc
146 
147  ! loop to read records
148  recordloop: do
149 
150  ! Read the line
151  call this%parser%GetNextLine(endofblock)
152  if (endofblock) exit
153  call this%parser%GetStringCaps(keyword1)
154 
155  ! Set printsave string and then read the record type (e.g.
156  ! BUDGET, HEAD)
157  printsave = keyword1
158  call this%parser%GetStringCaps(keyword2)
159 
160  ! Look through the output control data objects that are
161  ! available and set ocdobjptr to the correct one based on
162  ! cname. Set found to .false. if not a valid record type.
163  found = .false.
164  do ipos = 1, size(this%ocds)
165  ocdobjptr => this%ocds(ipos)
166  if (keyword2 == trim(ocdobjptr%cname)) then
167  found = .true.
168  exit
169  end if
170  end do
171  if (.not. found) then
172  call this%parser%GetCurrentLine(line)
173  write (ermsg, fmterr)
174  call store_error(ermsg)
175  call store_error('UNRECOGNIZED KEYWORD: '//keyword2)
176  call store_error(trim(line))
177  call this%parser%StoreErrorUnit()
178  end if
179  call this%parser%GetRemainingLine(line)
180  call ocdobjptr%psm%read(trim(printsave)//' '//line, &
181  this%iout)
182  call ocdobjptr%ocd_rp_check(this%parser%iuactive)
183  end do recordloop
184  write (this%iout, fmteoc) this%iperoc
185  else
186 
187  ! Write message that output control settings are from a previous
188  ! stress period.
189  write (this%iout, fmtroc) kper
190  end if
191  end subroutine oc_rp
192 
193  !> @ brief Write output.
194  !!
195  !! Go through each output control data type and print
196  !! and/or save data based on user-specified controls.
197  !<
198  subroutine oc_ot(this, ipflg)
199  ! modules
200  use tdismodule, only: kstp, endofperiod
201  ! dummy
202  class(outputcontroltype) :: this !< OutputControlType object
203  integer(I4B), intent(inout) :: ipflg !< flag indicating if data was printed
204  ! local
205  integer(I4B) :: ipos
206  type(outputcontroldatatype), pointer :: ocdobjptr
207 
208  ! Clear printout flag(ipflg). This flag indicates that an array was
209  ! printed to the listing file.
210  ipflg = 0
211 
212  do ipos = 1, size(this%ocds)
213  ocdobjptr => this%ocds(ipos)
214  call ocdobjptr%ocd_ot(ipflg, kstp, endofperiod, this%iout)
215  end do
216  end subroutine oc_ot
217 
218  !> @ brief Deallocate method for OutputControlType
219  !!
220  !! Deallocate member variables.
221  !!
222  !<
223  subroutine oc_da(this)
224  ! modules
226  ! dummy
227  class(outputcontroltype) :: this !< OutputControlType object
228  ! local
229  integer(I4B) :: i
230 
231  do i = 1, size(this%ocds)
232  call this%ocds(i)%ocd_da()
233  end do
234  deallocate (this%ocds)
235 
236  deallocate (this%name_model)
237  call mem_deallocate(this%inunit)
238  call mem_deallocate(this%iout)
239  call mem_deallocate(this%ibudcsv)
240  call mem_deallocate(this%iperoc)
241  call mem_deallocate(this%iocrep)
242  end subroutine oc_da
243 
244  !> @ brief Allocate variables for the output control object
245  subroutine allocate (this, name_model)
246  ! modules
249  ! dummy
250  class(outputcontroltype) :: this !< this instance
251  character(len=*), intent(in) :: name_model !< name of model
252 
253  this%memoryPath = create_mem_path(name_model, 'OC')
254 
255  allocate (this%name_model)
256  call mem_allocate(this%inunit, 'INUNIT', this%memoryPath)
257  call mem_allocate(this%iout, 'IOUT', 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)
261 
262  this%name_model = name_model
263  this%inunit = 0
264  this%iout = 0
265  this%ibudcsv = 0
266  this%iperoc = 0
267  this%iocrep = 0
268  end subroutine allocate
269 
270  !> @ brief Read the output control options block
271  subroutine read_options(this)
272  ! modules
273  use constantsmodule, only: linelength
275  ! dummy
276  class(outputcontroltype) :: this !< this instance
277  ! local
278  character(len=LINELENGTH) :: keyword
279  character(len=LINELENGTH) :: keyword2
280  character(len=LINELENGTH) :: fname
281  character(len=:), allocatable :: line
282  integer(I4B) :: ierr
283  integer(I4B) :: ipos
284  logical :: isfound, found, endOfBlock
285  type(outputcontroldatatype), pointer :: ocdobjptr
286 
287  ! get options block
288  call this%parser%GetBlock('OPTIONS', isfound, ierr, &
289  supportopenclose=.true., blockrequired=.false.)
290 
291  ! parse options block if detected
292  if (isfound) then
293  write (this%iout, '(/,1x,a,/)') 'PROCESSING OC OPTIONS'
294  do
295  call this%parser%GetNextLine(endofblock)
296  if (endofblock) exit
297  call this%parser%GetStringCaps(keyword)
298  found = .false.
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)//"'."
304  call store_error(errmsg)
305  call this%parser%StoreErrorUnit()
306  end if
307  call this%parser%GetString(fname)
308  this%ibudcsv = getunit()
309  call openfile(this%ibudcsv, this%iout, fname, 'CSV', &
310  filstat_opt='REPLACE')
311  found = .true.
312  end if
313 
314  if (.not. found) then
315  do ipos = 1, size(this%ocds)
316  ocdobjptr => this%ocds(ipos)
317  if (keyword == trim(ocdobjptr%cname)) then
318  found = .true.
319  exit
320  end if
321  end do
322  if (.not. found) then
323  errmsg = "UNKNOWN OC OPTION '"//trim(keyword)//"'."
324  call store_error(errmsg)
325  call this%parser%StoreErrorUnit()
326  end if
327  call this%parser%GetRemainingLine(line)
328  call ocdobjptr%set_option(line, this%parser%iuactive, this%iout)
329  end if
330  end do
331  write (this%iout, '(1x,a)') 'END OF OC OPTIONS'
332  end if
333  end subroutine read_options
334 
335  !> @ brief Determine if it is time to save.
336  logical function oc_save(this, cname)
337  ! modules
338  use tdismodule, only: kstp, endofperiod
339  ! dummy
340  class(outputcontroltype) :: this !< OutputControlType object
341  character(len=*), intent(in) :: cname !< character string for data name
342  ! local
343  integer(I4B) :: ipos
344  logical :: found
345  class(outputcontroldatatype), pointer :: ocdobjptr
346  !
347  oc_save = .false.
348  found = .false.
349  do ipos = 1, size(this%ocds)
350  ocdobjptr => this%ocds(ipos)
351  if (cname == trim(ocdobjptr%cname)) then
352  found = .true.
353  exit
354  end if
355  end do
356  if (found) then
357  oc_save = ocdobjptr%psm%should_save(kstp, endofperiod)
358  end if
359  end function oc_save
360 
361  !> @ brief Determine if it is time to print.
362  logical function oc_print(this, cname)
363  ! modules
364  use tdismodule, only: kstp, endofperiod
365  ! dummy
366  class(outputcontroltype) :: this !< OutputControlType object
367  character(len=*), intent(in) :: cname !< character string for data name
368  ! local
369  integer(I4B) :: ipos
370  logical :: found
371  class(outputcontroldatatype), pointer :: ocdobjptr
372 
373  oc_print = .false.
374  found = .false.
375  do ipos = 1, size(this%ocds)
376  ocdobjptr => this%ocds(ipos)
377  if (cname == trim(ocdobjptr%cname)) then
378  found = .true.
379  exit
380  end if
381  end do
382  if (found) then
383  oc_print = ocdobjptr%psm%should_print(kstp, endofperiod)
384  end if
385  end function oc_print
386 
387  !> @ brief Determine unit number for saving
388  function oc_save_unit(this, cname)
389  ! -- modules
390  ! -- return
391  integer(I4B) :: oc_save_unit
392  ! -- dummy
393  class(outputcontroltype) :: this !< OutputControlType object
394  character(len=*), intent(in) :: cname !< character string for data name
395  ! -- local
396  integer(I4B) :: ipos
397  logical :: found
398  class(outputcontroldatatype), pointer :: ocdobjptr
399  !
400  oc_save_unit = 0
401  found = .false.
402  do ipos = 1, size(this%ocds)
403  ocdobjptr => this%ocds(ipos)
404  if (cname == trim(ocdobjptr%cname)) then
405  found = .true.
406  exit
407  end if
408  end do
409  if (found) then
410  oc_save_unit = ocdobjptr%idataun
411  end if
412  end function oc_save_unit
413 
414  !> @ brief Set the print flag based on convergence and other parameters
415  function set_print_flag(this, cname, icnvg, endofperiod) result(iprint_flag)
416  ! -- modules
418  ! -- return
419  integer(I4B) :: iprint_flag
420  ! -- dummy
421  class(outputcontroltype) :: this !< OutputControlType object
422  character(len=*), intent(in) :: cname !< character string for data name
423  integer(I4B), intent(in) :: icnvg !< convergence flag
424  logical, intent(in) :: endofperiod !< end of period logical flag
425  ! -- local
426  !
427  ! -- default is to not print
428  iprint_flag = 0
429  !
430  ! -- if the output control file indicates that cname should be printed
431  if (this%oc_print(cname)) iprint_flag = 1
432  !
433  ! -- if it is not a CONTINUE run, then set to print if not converged
434  if (isimcontinue == 0) then
435  if (icnvg == 0) iprint_flag = 1
436  end if
437  !
438  ! -- if it's the end of the period, then set flag to print
439  if (endofperiod) iprint_flag = 1
440  end function set_print_flag
441 
442 end module outputcontrolmodule
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 lenmempath
maximum length of the memory path
Definition: Constants.f90:27
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
Output control data module.
subroutine, public ocd_cr(ocdobj)
@ brief Create a new output control data type.
Model output control.
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.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
This module contains simulation variables.
Definition: SimVariables.f90:9
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
Definition: tdis.f90:27
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
@ brief Controls model output. Overridden for each model type.