outputcontrolmodule Module Reference

This module contains the OutputControlModule. More...

Data Types
type	outputcontroltype
	@ brief OutputControlType More...

Functions/Subroutines
subroutine, public	oc_cr (ocobj, name_model, inunit, iout)
	@ brief Create OutputControlType More...
subroutine	oc_df (this)
	@ brief Define OutputControlType More...
subroutine	oc_rp (this)
	@ brief Read and prepare OutputControlType More...
subroutine	oc_ot (this, ipflg)
	@ brief Output method for OutputControlType More...
subroutine	oc_da (this)
	@ brief Deallocate method for OutputControlType More...
subroutine	allocate_scalars (this, name_model)
	@ brief Allocate scalars method for OutputControlType More...
subroutine	read_options (this)
	@ brief Read options for OutputControlType More...
logical function	oc_save (this, cname)
	@ brief Save data to file More...
logical function	oc_print (this, cname)
	@ brief Determine if 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 More...

Detailed Description

This module defines the OutputControlType. This type is overridden by GWF and GWT to create an Output Control package for the model.

Function/Subroutine Documentation

allocate_scalars()

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

Allocate and initialize member variables.

Parameters

	this	OutputControlType object
[in]	name_model	name of model

Definition at line 299 of file OutputControl.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    use memoryhelpermodule, only: create_mem_path
    ! -- dummy
    class(OutputControlType) :: this !< OutputControlType object
    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
    !
    ! -- return
    return

Here is the call graph for this function:

oc_cr()

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

Create by allocating a new OutputControlType object and initializing member variables.

Parameters

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

Definition at line 57 of file OutputControl.f90.

    ! -- dummy
    type(OutputControlType), pointer :: ocobj !< 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
    !
    ! -- Create the object
    allocate (ocobj)
    !
    ! -- Allocate scalars
    call ocobj%allocate_scalars(name_model)
    !
    ! -- Save unit numbers
    ocobj%inunit = inunit
    ocobj%iout = iout
    !
    ! -- Initialize block parser
    call ocobj%parser%Initialize(inunit, iout)
    !
    ! -- Return
    return

oc_da()

subroutine outputcontrolmodule::oc_da

(

class(outputcontroltype)

this

)

Deallocate member variables.

Parameters

this	OutputControlType object

Definition at line 270 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%ocdobj)
      call this%ocdobj(i)%ocd_da()
    end do
    deallocate (this%ocdobj)
    !
    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)
    !
    ! -- return
    return

oc_df()

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

private

Placeholder routine for the moment.

Parameters

this	OutputControlType object

Definition at line 86 of file OutputControl.f90.

    ! -- dummy
    class(OutputControlType) :: this !< OutputControlType object
    !
    ! -- Return
    return

oc_ot()

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

Go through each output control data type and output, which will 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 242 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%ocdobj)
      ocdobjptr => this%ocdobj(ipos)
      call ocdobjptr%ocd_ot(ipflg, kstp, endofperiod, this%iout)
    end do
    !
    ! -- Return
    return

oc_print()

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

Determine if it is time to print the data corresponding to cname.

Parameters

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

Definition at line 437 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%ocdobj)
      ocdobjptr => this%ocdobj(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_print = ocdobjptr%psmobj%kstp_to_print(kstp, endofperiod)
    end if
    !
    ! -- Return
    return

oc_rp()

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

private

Read a period data block.

Parameters

this	OutputControlType object

Definition at line 99 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 !< OutputControlType object
    ! -- 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%ocdobj)
        ocdobjptr => this%ocdobj(ipos)
        call ocdobjptr%psmobj%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%ocdobj)
          ocdobjptr => this%ocdobj(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%psmobj%rp(trim(printsave)//' '//line, &
                                 this%iout)
        call ocdobjptr%ocd_rp_check(this%parser%iuactive)
        !
        ! -- End of recordloop
      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
    !
    ! -- return
    return

Here is the call graph for this function:

oc_save()

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

Go through data and save if requested by user.

Parameters

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

Definition at line 404 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%ocdobj)
      ocdobjptr => this%ocdobj(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_save = ocdobjptr%psmobj%kstp_to_save(kstp, endofperiod)
    end if
    !
    ! -- Return
    return

oc_save_unit()

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

Determine the unit number for saving cname.

Parameters

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

Definition at line 470 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%ocdobj)
      ocdobjptr => this%ocdobj(ipos)
      if (cname == trim(ocdobjptr%cname)) then
        found = .true.
        exit
      end if
    end do
    if (found) then
      oc_save_unit = ocdobjptr%idataun
    end if
    !
    ! -- Return
    return

read_options()

subroutine outputcontrolmodule::read_options

(

class(outputcontroltype)

this

)

Read options block and set member variables.

Parameters

this	OutputControlType object

Definition at line 332 of file OutputControl.f90.

    ! -- modules
    use constantsmodule, only: linelength
    use simmodule, only: store_error, store_error_unit
    ! -- dummy
    class(OutputControlType) :: this !< OutputControlType object
    ! -- 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%ocdobj)
            ocdobjptr => this%ocdobj(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
    !
    ! -- return
    return

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

Set the print flag based on convergence and simulation parameters.

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 504 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
    !
    ! -- Return
    return