OutputControlData.f90

Go to the documentation of this file.

!> @brief Output control data module.
module outputcontroldatamodule
 
  use basedismodule, only: disbasetype
  use inputoutputmodule, only: print_format
  use kindmodule, only: dp, i4b, lgp
  use printsavemanagermodule, only: printsavemanagertype, create_psm
 
  implicit none
  private
  public outputcontroldatatype, ocd_cr
 
  !> @brief Output control data type.
  !!
  !! Determines whether output data should be printed to a list file or saved to disk.
  !! This type can be assigned to different variables, such as head or concentration.
  !! This type controls the logging and saving of output data in a consistent manner.
  !<
  type outputcontroldatatype
    class(disbasetype), pointer :: dis => null() !< discretization package
    type(printsavemanagertype), pointer :: psm => null() !< print/save manager
    character(len=16), pointer :: cname => null() !< name of variable, such as HEAD
    character(len=60), pointer :: cdatafmp => null() !< fortran format for printing
    character(len=1), pointer :: editdesc => null() !< fortran format type (I, G, F, S, E)
    integer(I4B), pointer :: idataun => null() !< fortran unit number for binary output
    integer(I4B), pointer :: nvaluesp => null() !< number of values per line for printing
    integer(I4B), pointer :: nwidthp => null() !< width of the number for printing
    integer(I4B), pointer :: inodata => null() !< integer no data value
    real(dp), pointer :: dnodata => null() !< no data value
    integer(I4B), pointer, contiguous :: intdata(:) => null() !< integer data array
    real(dp), pointer, contiguous :: dbldata(:) => null() !< double precision data array
  contains
    procedure :: allocate_scalars => allocate
    procedure :: init_int
    procedure :: init_dbl
    procedure :: set_option
    procedure :: ocd_rp_check
    procedure :: ocd_ot
    procedure :: ocd_da
  end type outputcontroldatatype
 
contains
 
  !> @ brief Create a new output control data type.
  subroutine ocd_cr(ocdobj)
    type(outputcontroldatatype), pointer :: ocdobj !< this instance
    allocate (ocdobj)
    call ocdobj%allocate_scalars()
  end subroutine ocd_cr
 
  !> @ brief Check the output control data type for consistency.
  subroutine ocd_rp_check(this, inunit)
    ! modules
    use constantsmodule, only: linelength
    use simmodule, only: store_error, count_errors, store_error_unit
    ! dummy
    class(outputcontroldatatype) :: this !< this instance
    integer(I4B), intent(in) :: inunit !< output unit number
    ! locals
    character(len=LINELENGTH) :: errmsg
    ! formats
    character(len=*), parameter :: fmtocsaveerr = &
      "(1X,'REQUESTING TO SAVE ',A,' BUT ',A,' SAVE FILE NOT SPECIFIED. ', &
       &A,' SAVE FILE MUST BE SPECIFIED IN OUTPUT CONTROL OPTIONS.')"
 
    ! If saving is enabled, make sure an output file was specified
    if (this%psm%save_steps%any()) then
      if (this%idataun == 0) then
        write (errmsg, fmtocsaveerr) trim(adjustl(this%cname)), &
          trim(adjustl(this%cname)), &
          trim(adjustl(this%cname))
        call store_error(errmsg)
      end if
    end if
 
    if (count_errors() > 0) then
      call store_error_unit(inunit)
    end if
  end subroutine ocd_rp_check
 
  !> @brief Write to list file and/or save to binary file, depending on settings.
  subroutine ocd_ot(this, ipflg, kstp, endofperiod, iout, iprint_opt, isav_opt)
    ! dummy
    class(outputcontroldatatype) :: this !< OutputControlDataType object
    integer(I4B), intent(inout) :: ipflg !< Flag indicating if something was printed
    integer(I4B), intent(in) :: kstp !< Current time step
    logical(LGP), intent(in) :: endofperiod !< End of period logical flag
    integer(I4B), intent(in) :: iout !< Unit number for output
    integer(I4B), optional, intent(in) :: iprint_opt !< Optional print flag override
    integer(I4B), optional, intent(in) :: isav_opt !< Optional save flag override
    ! local
    integer(I4B) :: iprint
    integer(I4B) :: idataun
 
    ! Initialize
    iprint = 0
    ipflg = 0
    idataun = 0
 
    ! Determine whether or not to print the array.  The present
    ! check allows a caller to override the print/save manager
    if (present(iprint_opt)) then
      if (iprint_opt /= 0) then
        iprint = 1
        ipflg = 1
      end if
    else
      if (this%psm%should_print(kstp, endofperiod)) then
        iprint = 1
        ipflg = 1
      end if
    end if
 
    ! Determine whether to save the array to a file
    if (present(isav_opt)) then
      if (isav_opt /= 0) then
        idataun = this%idataun
      end if
    else
      if (this%psm%should_save(kstp, endofperiod)) idataun = this%idataun
    end if
 
    ! Record double precision array
    if (associated(this%dbldata)) &
      call this%dis%record_array(this%dbldata, iout, iprint, idataun, &
                                 this%cname, this%cdatafmp, this%nvaluesp, &
                                 this%nwidthp, this%editdesc, this%dnodata)
 
    ! Record integer array (not supported yet)
    !if(associated(this%intvec)) &
    !call this%dis%record_array(this%intvec, iout, iprint, idataun, &
    !                               this%cname, this%cdatafmp, this%nvaluesp, &
    !                               this%nwidthp, this%editdesc, this%inodata)
  end subroutine ocd_ot
 
  !> @brief Deallocate the output control data type
  subroutine ocd_da(this)
    class(outputcontroldatatype) :: this
 
    deallocate (this%cname)
    deallocate (this%cdatafmp)
    deallocate (this%idataun)
    deallocate (this%editdesc)
    deallocate (this%nvaluesp)
    deallocate (this%nwidthp)
    deallocate (this%dnodata)
    deallocate (this%inodata)
  end subroutine ocd_da
 
  !> @brief Initialize the output control data type for double precision data.
  subroutine init_dbl(this, cname, dblvec, dis, cdefpsm, cdeffmp, iout, &
                      dnodata)
    class(outputcontroldatatype) :: this !< OutputControlDataType object
    character(len=*), intent(in) :: cname !< Name of variable
    real(DP), dimension(:), pointer, contiguous, intent(in) :: dblvec !< Data array that will be managed by this object
    class(disbasetype), pointer, intent(in) :: dis !< Discretization package
    character(len=*), intent(in) :: cdefpsm !< String for defining the print/save manager
    character(len=*), intent(in) :: cdeffmp !< String for print format
    integer(I4B), intent(in) :: iout !< Unit number for output
    real(DP), intent(in) :: dnodata !< No data value
 
    this%cname = cname
    this%dbldata => dblvec
    this%dis => dis
    this%dnodata = dnodata
    if (cdefpsm /= '') call this%psm%read(cdefpsm, iout)
    call print_format(cdeffmp, this%cdatafmp, &
                      this%editdesc, this%nvaluesp, this%nwidthp, 0)
  end subroutine init_dbl
 
  !> @ brief Initialize the output control data type for integer data.
  subroutine init_int(this, cname, intvec, dis, cdefpsm, cdeffmp, iout, &
                      inodata)
    class(outputcontroldatatype) :: this !< OutputControlDataType object
    character(len=*), intent(in) :: cname !< Name of variable
    integer(I4B), dimension(:), pointer, contiguous, intent(in) :: intvec !< Data array that will be managed by this object
    class(disbasetype), pointer, intent(in) :: dis !< Discretization package
    character(len=*), intent(in) :: cdefpsm !< String for defining the print/save manager
    character(len=*), intent(in) :: cdeffmp !< String for print format
    integer(I4B), intent(in) :: iout !< Unit number for output
    integer(I4B), intent(in) :: inodata !< No data value
 
    this%cname = cname
    this%intdata => intvec
    this%dis => dis
    this%inodata = inodata
    this%editdesc = 'I'
    if (cdefpsm /= '') call this%psm%read(cdefpsm, iout)
    call print_format(cdeffmp, this%cdatafmp, this%editdesc, this%nvaluesp, &
                      this%nwidthp, 0)
  end subroutine init_int
 
  !> @ brief Allocate scalar variables
  subroutine allocate (this)
    ! modules
    use constantsmodule, only: dzero
    ! dummy
    class(outputcontroldatatype) :: this !< OutputControlDataType object
 
    allocate (this%cname)
    allocate (this%cdatafmp)
    allocate (this%idataun)
    allocate (this%editdesc)
    allocate (this%nvaluesp)
    allocate (this%nwidthp)
    allocate (this%dnodata)
    allocate (this%inodata)
 
    this%cname = ''
    this%cdatafmp = ''
    this%idataun = 0
    this%editdesc = ''
    this%nvaluesp = 0
    this%nwidthp = 0
    this%dnodata = dzero
    this%inodata = 0
    this%psm => create_psm()
  end subroutine allocate
 
  !> @ brief Set FILEOUT and PRINT_FORMAT based on an input string.
  subroutine set_option(this, linein, inunit, iout)
    ! modules
    use constantsmodule, only: mnormal
    use openspecmodule, only: access, form
    use inputoutputmodule, only: urword, getunit, openfile
    use simmodule, only: store_error, store_error_unit, count_errors
    ! dummy
    class(outputcontroldatatype) :: this !< OutputControlDataType object
    character(len=*), intent(in) :: linein !< Character string with options
    integer(I4B), intent(in) :: inunit !< Unit number for input
    integer(I4B), intent(in) :: iout !< Unit number for output
    ! local
    character(len=len(linein)) :: line
    integer(I4B) :: lloc, istart, istop, ival
    real(DP) :: rval
    ! format
    character(len=*), parameter :: fmtocsave = &
      "(4X,A,' INFORMATION WILL BE WRITTEN TO:', &
      &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
 
    line(:) = linein(:)
    lloc = 1
    call urword(line, lloc, istart, istop, 1, ival, rval, 0, 0)
    select case (line(istart:istop))
    case ('FILEOUT')
      call urword(line, lloc, istart, istop, 0, ival, rval, 0, 0)
      this%idataun = getunit()
      write (iout, fmtocsave) trim(adjustl(this%cname)), this%idataun, &
        line(istart:istop)
      call openfile(this%idataun, iout, line(istart:istop), 'DATA(BINARY)', &
                    form, access, 'REPLACE', mnormal)
    case ('PRINT_FORMAT')
      call urword(line, lloc, istart, istop, 1, ival, rval, 0, 0)
      call print_format(line(istart:), this%cdatafmp, this%editdesc, &
                        this%nvaluesp, this%nwidthp, inunit)
    case default
      call store_error('Looking for FILEOUT or PRINT_FORMAT.  Found:')
      call store_error(trim(adjustl(line)))
      call store_error_unit(inunit)
    end select
  end subroutine set_option
 
end module outputcontroldatamodule