outputcontrolmodule Module Reference

Model output control.

Data Types
type	outputcontroltype
	@ brief Controls model output. Overridden for each model type. More...

Functions/Subroutines
subroutine, public	oc_cr (oc, name_model, inunit, iout)
	Create a new output control object. More...
subroutine	oc_df (this)
	@ brief Define the output control type. Placeholder routine. More...
subroutine	oc_rp (this)
	@ brief Read period block options and prepare the output control type. More...
subroutine	oc_ot (this, ipflg)
	@ brief Write output. More...
subroutine	oc_da (this)
	@ brief Deallocate method for OutputControlType More...
subroutine	allocate (this, name_model)
	@ brief Allocate variables for the output control object More...
subroutine	read_options (this)
	@ brief Read the output control options block More...
logical function	oc_save (this, cname)
	@ brief Determine if it is time to save. More...
logical function	oc_print (this, cname)
	@ brief Determine if it is time to print. More...
integer(i4b) function	oc_save_unit (this, cname)
	@ brief Determine unit number for saving More...
integer(i4b) function	set_print_flag (this, cname, icnvg, endofperiod)
	@ brief Set the print flag based on convergence and other parameters More...

Function/Subroutine Documentation

allocate()

subroutine outputcontrolmodule::allocate	(	class(outputcontroltype)	this,
		character(len=*), intent(in)	name_model
	)

Parameters

	this	this instance
[in]	name_model	name of model

Definition at line 245 of file OutputControl.f90.

    ! modules
    use memorymanagermodule, only: mem_allocate
    use memoryhelpermodule, only: create_mem_path
    ! dummy
    class(OutputControlType) :: this !< this instance
    character(len=*), intent(in) :: name_model !< name of model
 
    this%memoryPath = create_mem_path(name_model, 'OC')
 
    allocate (this%name_model)
    call mem_allocate(this%inunit, 'INUNIT', this%memoryPath)
    call mem_allocate(this%iout, 'IOUT', this%memoryPath)
    call mem_allocate(this%ibudcsv, 'IBUDCSV', this%memoryPath)
    call mem_allocate(this%iperoc, 'IPEROC', this%memoryPath)
    call mem_allocate(this%iocrep, 'IOCREP', this%memoryPath)
 
    this%name_model = name_model
    this%inunit = 0
    this%iout = 0
    this%ibudcsv = 0
    this%iperoc = 0
    this%iocrep = 0

Here is the call graph for this function:

oc_cr()

subroutine, public outputcontrolmodule::oc_cr	(	type(outputcontroltype), pointer	oc,
		character(len=*), intent(in)	name_model,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout
	)

Parameters

	oc	OutputControlType object
[in]	name_model	name of the model
[in]	inunit	unit number for input
[in]	iout	unit number for output

Definition at line 42 of file OutputControl.f90.

    type(OutputControlType), pointer :: oc !< OutputControlType object
    character(len=*), intent(in) :: name_model !< name of the model
    integer(I4B), intent(in) :: inunit !< unit number for input
    integer(I4B), intent(in) :: iout !< unit number for output
 
    allocate (oc)
    call oc%allocate_scalars(name_model)
    oc%inunit = inunit
    oc%iout = iout
    call oc%parser%Initialize(inunit, iout)

oc_da()

subroutine outputcontrolmodule::oc_da

(

class(outputcontroltype)

this

)

Deallocate member variables.

Parameters

this	OutputControlType object

Definition at line 223 of file OutputControl.f90.

    ! modules
    use memorymanagermodule, only: mem_deallocate
    ! dummy
    class(OutputControlType) :: this !< OutputControlType object
    ! local
    integer(I4B) :: i
 
    do i = 1, size(this%ocds)
      call this%ocds(i)%ocd_da()
    end do
    deallocate (this%ocds)
 
    deallocate (this%name_model)
    call mem_deallocate(this%inunit)
    call mem_deallocate(this%iout)
    call mem_deallocate(this%ibudcsv)
    call mem_deallocate(this%iperoc)
    call mem_deallocate(this%iocrep)

oc_df()

subroutine outputcontrolmodule::oc_df ( class(outputcontroltype)  this )

private

Parameters

this	this instance

Definition at line 56 of file OutputControl.f90.

    class(OutputControlType) :: this !< this instance

oc_ot()

subroutine outputcontrolmodule::oc_ot	(	class(outputcontroltype)	this,
		integer(i4b), intent(inout)	ipflg
	)

Go through each output control data type and print and/or save data based on user-specified controls.

Parameters

	this	OutputControlType object
[in,out]	ipflg	flag indicating if data was printed

Definition at line 198 of file OutputControl.f90.

    ! modules
    use tdismodule, only: kstp, endofperiod
    ! dummy
    class(OutputControlType) :: this !< OutputControlType object
    integer(I4B), intent(inout) :: ipflg !< flag indicating if data was printed
    ! local
    integer(I4B) :: ipos
    type(OutputControlDataType), pointer :: ocdobjptr
 
    ! Clear printout flag(ipflg).  This flag indicates that an array was
    ! printed to the listing file.
    ipflg = 0
 
    do ipos = 1, size(this%ocds)
      ocdobjptr => this%ocds(ipos)
      call ocdobjptr%ocd_ot(ipflg, kstp, endofperiod, this%iout)
    end do

oc_print()

logical function outputcontrolmodule::oc_print	(	class(outputcontroltype)	this,
		character(len=*), intent(in)	cname
	)

Parameters

	this	OutputControlType object
[in]	cname	character string for data name

Definition at line 362 of file OutputControl.f90.

    ! modules
    use tdismodule, only: kstp, endofperiod
    ! dummy
    class(OutputControlType) :: this !< OutputControlType object
    character(len=*), intent(in) :: cname !< character string for data name
    ! local
    integer(I4B) :: ipos
    logical :: found
    class(OutputControlDataType), pointer :: ocdobjptr
 
    oc_print = .false.
    found = .false.
    do ipos = 1, size(this%ocds)
      ocdobjptr => this%ocds(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_print = ocdobjptr%psm%should_print(kstp, endofperiod)
    end if

oc_rp()

subroutine outputcontrolmodule::oc_rp ( class(outputcontroltype)  this )

private

Parameters

this	this instance

Definition at line 61 of file OutputControl.f90.

    ! modules
    use tdismodule, only: kper, nper
    use constantsmodule, only: linelength
    use simmodule, only: store_error, store_error_unit, count_errors
    ! dummy
    class(OutputControlType) :: this !< this instance
    ! local
    integer(I4B) :: ierr, ival, ipos
    logical :: isfound, found, endOfBlock
    character(len=:), allocatable :: line
    character(len=LINELENGTH) :: ermsg, keyword1, keyword2
    character(len=LINELENGTH) :: printsave
    class(OutputControlDataType), pointer :: ocdobjptr
    ! formats
    character(len=*), parameter :: fmtboc = &
      &"(1X,/1X,'BEGIN READING OUTPUT CONTROL FOR STRESS PERIOD ',I0)"
    character(len=*), parameter :: fmteoc = &
      &"(/,1X,'END READING OUTPUT CONTROL FOR STRESS PERIOD ',I0)"
    character(len=*), parameter :: fmterr = &
      &"(' ERROR READING OUTPUT CONTROL PERIOD BLOCK: ')"
    character(len=*), parameter :: fmtroc = &
      "(1X,/1X,'OUTPUT CONTROL FOR STRESS PERIOD ',I0, &
      &' IS REPEATED USING SETTINGS FROM A PREVIOUS STRESS PERIOD.')"
    character(len=*), parameter :: fmtpererr = &
      &"(1x,'CURRENT STRESS PERIOD GREATER THAN PERIOD IN OUTPUT CONTROL.')"
    character(len=*), parameter :: fmtpererr2 = &
      &"(1x,'CURRENT STRESS PERIOD: ',I0,' SPECIFIED STRESS PERIOD: ',I0)"
 
    ! Read next block header if kper greater than last one read
    if (this%iperoc < kper) then
 
      ! Get period block
      call this%parser%GetBlock('PERIOD', isfound, ierr, &
                                supportopenclose=.true., &
                                blockrequired=.false.)
 
      ! If end of file, set iperoc past kper, else parse line
      if (ierr < 0) then
        this%iperoc = nper + 1
        write (this%iout, '(/,1x,a)') 'END OF FILE DETECTED IN OUTPUT CONTROL.'
        write (this%iout, '(1x,a)') 'CURRENT OUTPUT CONTROL SETTINGS WILL BE '
        write (this%iout, '(1x,a)') 'REPEATED UNTIL THE END OF THE SIMULATION.'
      else
 
        ! Read period number
        ival = this%parser%GetInteger()
 
        ! Check to see if this is a valid kper
        if (ival <= 0 .or. ival > nper) then
          write (ermsg, '(a,i0)') 'PERIOD NOT VALID IN OUTPUT CONTROL: ', ival
          call store_error(ermsg)
          write (ermsg, '(a, a)') 'LINE: ', trim(adjustl(line))
          call store_error(ermsg)
        end if
 
        ! Check to see if specified is less than kper
        if (ival < kper) then
          write (ermsg, fmtpererr)
          call store_error(ermsg)
          write (ermsg, fmtpererr2) kper, ival
          call store_error(ermsg)
          write (ermsg, '(a, a)') 'LINE: ', trim(adjustl(line))
          call store_error(ermsg)
        end if
 
        ! Stop or set iperoc and continue
        if (count_errors() > 0) then
          call this%parser%StoreErrorUnit()
        end if
        this%iperoc = ival
      end if
    end if
 
    ! Read the stress period block
    if (this%iperoc == kper) then
 
      ! Clear io flags
      do ipos = 1, size(this%ocds)
        ocdobjptr => this%ocds(ipos)
        call ocdobjptr%psm%init()
      end do
 
      ! Output control time step matches simulation time step.
      write (this%iout, fmtboc) this%iperoc
 
      ! loop to read records
      recordloop: do
 
        ! Read the line
        call this%parser%GetNextLine(endofblock)
        if (endofblock) exit
        call this%parser%GetStringCaps(keyword1)
 
        ! Set printsave string and then read the record type (e.g.
        ! BUDGET, HEAD)
        printsave = keyword1
        call this%parser%GetStringCaps(keyword2)
 
        ! Look through the output control data objects that are
        ! available and set ocdobjptr to the correct one based on
        ! cname.  Set found to .false. if not a valid record type.
        found = .false.
        do ipos = 1, size(this%ocds)
          ocdobjptr => this%ocds(ipos)
          if (keyword2 == trim(ocdobjptr%cname)) then
            found = .true.
            exit
          end if
        end do
        if (.not. found) then
          call this%parser%GetCurrentLine(line)
          write (ermsg, fmterr)
          call store_error(ermsg)
          call store_error('UNRECOGNIZED KEYWORD: '//keyword2)
          call store_error(trim(line))
          call this%parser%StoreErrorUnit()
        end if
        call this%parser%GetRemainingLine(line)
        call ocdobjptr%psm%read(trim(printsave)//' '//line, &
                                this%iout)
        call ocdobjptr%ocd_rp_check(this%parser%iuactive)
      end do recordloop
      write (this%iout, fmteoc) this%iperoc
    else
 
      ! Write message that output control settings are from a previous
      ! stress period.
      write (this%iout, fmtroc) kper
    end if

Here is the call graph for this function:

oc_save()

logical function outputcontrolmodule::oc_save	(	class(outputcontroltype)	this,
		character(len=*), intent(in)	cname
	)

Parameters

	this	OutputControlType object
[in]	cname	character string for data name

Definition at line 336 of file OutputControl.f90.

    ! modules
    use tdismodule, only: kstp, endofperiod
    ! dummy
    class(OutputControlType) :: this !< OutputControlType object
    character(len=*), intent(in) :: cname !< character string for data name
    ! local
    integer(I4B) :: ipos
    logical :: found
    class(OutputControlDataType), pointer :: ocdobjptr
    !
    oc_save = .false.
    found = .false.
    do ipos = 1, size(this%ocds)
      ocdobjptr => this%ocds(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_save = ocdobjptr%psm%should_save(kstp, endofperiod)
    end if

oc_save_unit()

integer(i4b) function outputcontrolmodule::oc_save_unit	(	class(outputcontroltype)	this,
		character(len=*), intent(in)	cname
	)

Parameters

	this	OutputControlType object
[in]	cname	character string for data name

Definition at line 388 of file OutputControl.f90.

    ! -- modules
    ! -- return
    integer(I4B) :: oc_save_unit
    ! -- dummy
    class(OutputControlType) :: this !< OutputControlType object
    character(len=*), intent(in) :: cname !< character string for data name
    ! -- local
    integer(I4B) :: ipos
    logical :: found
    class(OutputControlDataType), pointer :: ocdobjptr
    !
    oc_save_unit = 0
    found = .false.
    do ipos = 1, size(this%ocds)
      ocdobjptr => this%ocds(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_save_unit = ocdobjptr%idataun
    end if

read_options()

subroutine outputcontrolmodule::read_options

(

class(outputcontroltype)

this

)

Parameters

this	this instance

Definition at line 271 of file OutputControl.f90.

    ! modules
    use constantsmodule, only: linelength
    use simmodule, only: store_error, store_error_unit
    ! dummy
    class(OutputControlType) :: this !< this instance
    ! local
    character(len=LINELENGTH) :: keyword
    character(len=LINELENGTH) :: keyword2
    character(len=LINELENGTH) :: fname
    character(len=:), allocatable :: line
    integer(I4B) :: ierr
    integer(I4B) :: ipos
    logical :: isfound, found, endOfBlock
    type(OutputControlDataType), pointer :: ocdobjptr
 
    ! get options block
    call this%parser%GetBlock('OPTIONS', isfound, ierr, &
                              supportopenclose=.true., blockrequired=.false.)
 
    ! parse options block if detected
    if (isfound) then
      write (this%iout, '(/,1x,a,/)') 'PROCESSING OC OPTIONS'
      do
        call this%parser%GetNextLine(endofblock)
        if (endofblock) exit
        call this%parser%GetStringCaps(keyword)
        found = .false.
        if (keyword == 'BUDGETCSV') then
          call this%parser%GetStringCaps(keyword2)
          if (keyword2 /= 'FILEOUT') then
            errmsg = "BUDGETCSV must be followed by FILEOUT and then budget &
              &csv file name.  Found '"//trim(keyword2)//"'."
            call store_error(errmsg)
            call this%parser%StoreErrorUnit()
          end if
          call this%parser%GetString(fname)
          this%ibudcsv = getunit()
          call openfile(this%ibudcsv, this%iout, fname, 'CSV', &
                        filstat_opt='REPLACE')
          found = .true.
        end if
 
        if (.not. found) then
          do ipos = 1, size(this%ocds)
            ocdobjptr => this%ocds(ipos)
            if (keyword == trim(ocdobjptr%cname)) then
              found = .true.
              exit
            end if
          end do
          if (.not. found) then
            errmsg = "UNKNOWN OC OPTION '"//trim(keyword)//"'."
            call store_error(errmsg)
            call this%parser%StoreErrorUnit()
          end if
          call this%parser%GetRemainingLine(line)
          call ocdobjptr%set_option(line, this%parser%iuactive, this%iout)
        end if
      end do
      write (this%iout, '(1x,a)') 'END OF OC OPTIONS'
    end if

Here is the call graph for this function:

set_print_flag()

integer(i4b) function outputcontrolmodule::set_print_flag ( class(outputcontroltype)  this, character(len=*), intent(in)  cname, integer(i4b), intent(in)  icnvg, logical, intent(in)  endofperiod  )

private

Parameters

	this	OutputControlType object
[in]	cname	character string for data name
[in]	icnvg	convergence flag
[in]	endofperiod	end of period logical flag

Definition at line 415 of file OutputControl.f90.

    ! -- modules
    use simvariablesmodule, only: isimcontinue
    ! -- return
    integer(I4B) :: iprint_flag
    ! -- dummy
    class(OutputControlType) :: this !< OutputControlType object
    character(len=*), intent(in) :: cname !< character string for data name
    integer(I4B), intent(in) :: icnvg !< convergence flag
    logical, intent(in) :: endofperiod !< end of period logical flag
    ! -- local
    !
    ! -- default is to not print
    iprint_flag = 0
    !
    ! -- if the output control file indicates that cname should be printed
    if (this%oc_print(cname)) iprint_flag = 1
    !
    ! -- if it is not a CONTINUE run, then set to print if not converged
    if (isimcontinue == 0) then
      if (icnvg == 0) iprint_flag = 1
    end if
    !
    ! -- if it's the end of the period, then set flag to print
    if (endofperiod) iprint_flag = 1