obsmodule Module Reference

This module contains the derived type ObsType. More...

Data Types
type	obstype

Functions/Subroutines
subroutine, public	obs_cr (obs, inobs)
	@ brief Create a new ObsType object More...
subroutine, public	defaultobsidprocessor (obsrv, dis, inunitobs, iout)
	@ brief Process IDstring provided for each observation More...
subroutine	obs_df (this, iout, pkgname, filtyp, dis)
	@ brief Define some members of an ObsType object More...
subroutine	obs_ar (this)
	@ brief Allocate and read package observations More...
subroutine	obs_ad (this)
	@ brief Advance package observations More...
subroutine	obs_bd_clear (this)
	@ brief Clear observation output lines More...
subroutine	obs_ot (this)
	@ brief Output observation data More...
subroutine	obs_da (this)
	@ brief Deallocate observation data More...
subroutine	saveonesimval (this, obsrv, simval)
	@ brief Save a simulated value More...
subroutine	storeobstype (this, obsrvType, cumulative, indx)
	@ brief Store observation type More...
subroutine	allocate_scalars (this)
	@ brief Allocate observation scalars More...
subroutine	obs_ar1 (this, pkgname)
	@ brief Read observation options and output formats More...
subroutine	obs_ar2 (this, dis)
	@ brief Call procedure provided by package More...
subroutine	read_obs_options (this)
	@ brief Read observation options block More...
subroutine	define_fmts (this)
	@ brief Define observation output formats More...
subroutine	read_observations (this)
	@ brief Read observations More...
integer(i4b) function	get_num (this)
	@ brief Get the number of observations More...
subroutine	build_headers (this)
	@ brief Build observation headers More...
subroutine	get_obs_array (this, nObs, obsArray)
	@ brief Get an array of observations More...
type(obsdatatype) function, pointer	get_obs_datum (this, obsTypeID)
	@ brief Get an ObsDataType object More...
subroutine	set_obs_array (this, nObs, obsArray)
	@ brief Set observation array values More...
class(observetype) function, pointer	get_obs (this, indx)
	@ brief Get an ObserveType object More...
subroutine	read_obs_blocks (this, fname)
	@ brief Read observation blocks More...
subroutine	write_obs_simvals (this)
	@ brief Write observation data More...

Detailed Description

This module defines type ObsType, which is the highest-level derived type for implementing observations. All objects derived from NumericalModelType or BndType already contain an ObsType member.

Examples: NumericalModelType.obs BndType.obs

Similarly, an ObsType member could be added to, say, NumericalExchangeType or any other type that has DF, AR, RP, AD, BD, and OT routines.

IMPLEMENTATION OF OBSERVATIONS IN A MODEL OR PACKAGE

For simple boundary packages like RIV and DRN, only steps 1-6 are needed. For models and advanced packages like MAW and SFR, additional steps are needed.

1. (package only) Override BndType.bnd_obs_supported to return true. bnd_obs_supported is called from various places in code.

2. (optional) Write a subroutine that implements abstract interface ObserveModule.ProcessIdSub. (Not needed if IDstring, which identifies location in model to be observed, is either a single node number or a single {lay, row, col} set of indices).

   Examples: gwf_process_head_drawdown_obs_id, gwf_process_intercell_obs_id

   A package can allow IDstring to be a boundary name. Example: ObsModule.DefaultObsIdProcessor

3. Override BndType.bnd_df_obs() to define string(s) to be recognized as observation type(s) and (optional) assign ProcessIdPtr (not needed if IDstring is either a node number or a {lay, row, col} set of indices).

   Examples: gwf_df_obs, drn_df_obs

   When boundary names are allowed and developer wants simulated value to be cumulative (flow, for example) if user specifies multiple boundaries with the same BOUNDNAME, in bnd_df_obs call to ObsPackage.StoreObsType, provide cumulative argument as true. Otherwise, simulated values are not cumulative.

4. In DF routine: Call bnd_df_obs
5. In AR routine: Call ObsType.obs_ar. This reads the OBS input file. Example (gwf_ar): call thisobsobs_ar() Example (lak_ar): call thisobsobs_ar()

6. Override BndType.bnd_rp_obs for any package that needs to check user input or process observation input in any special way. If no special processing is needed, BndType.bnd_rp_obs can be used. This routine also expands the ObserveTypeindxbnds array for each observation in a package. ObserveTypeindxbnds is used to sum simulated values from multiple boundaries when BOUNDNAMES is used. Equivalent routine may or may not be needed for model observations. If needed, call it from bottom of RP routine.

   Examples: BndType.bnd_rp_obs, which is called from gwf_rp

7. In AD routine: Call ObsType.obs_ad Example: gwf_ad
8. Write a *_bd_obs routine. This is the routine that actually calculates the simulated value for each observation type supported by the model/package. Call *_bd_obs from the bottom of the _bd routine. *_bd_obs needs to: Call ObsType.obs_bd_clear For each observation: Calculate the simulated value Call ObsType.SaveOneSimval Examples: gwf_bd_obs, maw_bd_obs, lak_bd_obs
9. In BD routine: Call BndType.bnd_bd_obs Examples: BndType.bnd_bd calls bnd_bd_obs GwfModelType.gwf_bd calls gwf_bd_obs MawType.maw_bd calls maw_bd_obs LakType.lak_bd calls lak_bd_obs

10. Ensure that ObsType.obs_ot is called. For packages, obs_ot is called from the model _ot procedure. The model _ot procedure should also call obs_ot for its own observations. Do not call obs_ot from a package _ot procedure because the package _ot procedure may not be called, depending on Output Control settings (ibudfl).

    Note: BndType.bnd_ot_obs calls: ObsType.obs_ot

    Note: ObsType.obs_ot calls: store_all_simvals write_continuous_simvals obsOutputList.WriteOutputLines

BINARY OUTPUT:

When observation-output files are written, the user has the option to have output written to a binary file. Binary obs output files start with a 100-byte header structured as follows:

bytes 1-4 (ascii): Observation type contained in file; options are: "cont" – Continuous observations byte 5: blank bytes 6-11 (ascii): Precision of all floating-point values; options are: "single" – Single precision "double" – Double precision bytes 12-15 (ascii): LENOBSNAME (integer; length of observation names, in bytes) bytes 16-100: blank

IN A FILE OF CONTINUOUS OBSERVATIONS:

The 100-byte header is followed by: NOBS (4-byte integer) – Number of observations. NOBS repetitions of OBSNAME (ascii, LENOBSNAME bytes each). Any number of repetitions of: TIME SIMVAL-1 SIMVAL-2 ... SIMVAL-NOBS (floating point)

Function/Subroutine Documentation

allocate_scalars()

subroutine obsmodule::allocate_scalars ( class(obstype)  this )

private

Subroutine to allocate and initialize memory for non-allocatable

Definition at line 542 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    !
    allocate (this%active)
    allocate (this%inputFilename)
    allocate (this%obsOutputList)
    allocate (this%obsData(maxobstypes))
    !
    ! -- Initialize
    this%active = .false.
    this%inputFilename = ''
    !
    ! -- return
    return

build_headers()

subroutine obsmodule::build_headers ( class(obstype), target  this )

private

Subroutine to build headers for CSV-formatted and unformatted continuous-observation output files and write them to those files.

Each formatted header will have the form: "time,obsname-1,obsname-2, ..."

Definition at line 810 of file Obs.f90.

    ! -- module
    use iso_fortran_env, only: int32
    ! -- dummy
    class(ObsType), target :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: ii
    integer(I4B) :: idx
    integer(I4B) :: iu
    integer(I4B) :: num
    integer(int32) :: nobs
    character(len=4) :: clenobsname
    type(ObserveType), pointer :: obsrv => null()
    type(ObsOutputType), pointer :: obsOutput => null()
    !
    ! -- Cycle through ObsOutputList to write headers
    !    to formatted and unformatted file(s).
    idx = 1
    num = this%obsOutputList%Count()
    all_obsfiles: do i = 1, num
      obsoutput => this%obsOutputList%Get(i)
      nobs = obsoutput%nobs
      iu = obsoutput%nunit
      !
      ! -- write header information to the formatted file
      if (obsoutput%FormattedOutput) then
        write (iu, '(a)', advance='NO') 'time'
      else
        ! -- write header to unformatted file
        !    First 11 bytes are obs type and precision
        if (this%iprecision == 1) then
          ! -- single precision output
          write (iu) 'cont single'
        else if (this%iprecision == 2) then
          ! -- double precision output
          write (iu) 'cont double'
        end if
        ! -- write LENOBSNAME to bytes 12-15
        write (clenobsname, '(i4)') lenobsname
        write (iu) clenobsname
        ! -- write blanks to complete 100-byte header
        do ii = 16, 100
          write (iu) ' '
        end do
        ! -- write NOBS
        write (iu) nobs
      end if
      !
      ! -- write observation name
      obsfile: do ii = 1, nobs
        obsrv => this%get_obs(idx)
        if (obsoutput%FormattedOutput) then
          write (iu, '(a,a)', advance='NO') ',', trim(obsrv%Name)
          !
          ! -- terminate the line on the last observation in file
          if (ii == nobs) then
            write (iu, '(a)', advance='YES') ''
          end if
        else
          write (iu) obsrv%Name
        end if
        idx = idx + 1
      end do obsfile
    end do all_obsfiles
    !
    ! -- return
    return

defaultobsidprocessor()

subroutine, public obsmodule::defaultobsidprocessor	(	type(observetype), intent(inout)	obsrv,
		class(disbasetype), intent(in)	dis,
		integer(i4b), intent(in)	inunitobs,
		integer(i4b), intent(in)	iout
	)

Subroutine to process the IDstring provided for each observation. The IDstring identifies the location in the model of the node(s) or feature(s) where the simulated value is to be extracted and recorded. Subroutine

• interprets the IDstring
• stores the location of interest in the ObserveType object that contains information about the observation

  Parameters

  [in,out]	obsrv	observation ObserveType
  [in]	dis	discretization object
  [in]	inunitobs	observation input file unit
  [in]	iout	model list file

Definition at line 248 of file Obs.f90.

    ! -- dummy
    type(ObserveType), intent(inout) :: obsrv !< observation ObserveType
    class(DisBaseType), intent(in) :: dis !< discretization object
    integer(I4B), intent(in) :: inunitobs !< observation input file unit
    integer(I4B), intent(in) :: iout !< model list file
    ! -- local
    integer(I4B) :: n
    integer(I4B) :: icol, istart, istop
    character(len=LINELENGTH) :: string
    logical :: flag_string
    !
    ! -- Initialize variables
    string = obsrv%IDstring
    icol = 1
    flag_string = .true. ! Allow string to contain a boundary name
    !
    n = dis%noder_from_string(icol, istart, istop, inunitobs, &
                              iout, string, flag_string)
    !
    if (n > 0) then
      obsrv%NodeNumber = n
    elseif (n == -2) then
      ! Integer can't be read from string; it's presumed to be a boundary
      ! name (already converted to uppercase)
      obsrv%FeatureName = string(istart:istop)
      ! -- Observation may require summing rates from multiple boundaries,
      !    so assign NodeNumber as a value that indicates observation
      !    is for a named boundary or group of boundaries.
      obsrv%NodeNumber = namedboundflag
    else
      errmsg = 'Error reading data from ID string'
      call store_error(errmsg)
      call store_error_unit(inunitobs)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

Here is the caller graph for this function:

define_fmts()

subroutine obsmodule::define_fmts ( class(obstype)  this )

private

Subroutine to define observation output formats.

Definition at line 748 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    ! formats
50  format('(g', i2.2, '.', i2.2, ')')
    !
    if (this%idigits == 0) then
      this%obsfmtcont = '(G0)'
    else
      write (this%obsfmtcont, 50) this%idigits + 7, this%idigits
    end if
    !
    ! -- return
    return

get_num()

integer(i4b) function obsmodule::get_num ( class(obstype)  this )

private

Function to get the number of observationns in this ObsType object.

Returns

number of observations

Definition at line 790 of file Obs.f90.

    ! -- return
    integer(I4B) :: get_num !< number of observations
    ! -- dummy
    class(ObsType) :: this
    !
    get_num = this%obsList%Count()
    !
    ! -- return
    return

get_obs()

class(observetype) function, pointer obsmodule::get_obs ( class(obstype)  this, integer(i4b), intent(in)  indx  )

private

Subroutine to get an ObserveType object from the list of observations using an list index.

Parameters

[in]

indx

observation list index

Returns

observation ObserveType

Definition at line 969 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    integer(I4B), intent(in) :: indx !< observation list index
    class(ObserveType), pointer :: obsrv !< observation ObserveType
    !
    obsrv => getobsfromlist(this%obsList, indx)
    !
    ! -- return
    return

Here is the call graph for this function:

get_obs_array()

subroutine obsmodule::get_obs_array	(	class(obstype), intent(inout)	this,
		integer(i4b), intent(out)	nObs,
		type(obscontainertype), dimension(:), intent(inout), pointer	obsArray
	)

Subroutine to get an array containing all observations in this ObsType object.

Parameters

[out]	nobs	number of observations
[in,out]	obsarray	observation array

Definition at line 886 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    integer(I4B), intent(out) :: nObs !< number of observations
    type(ObsContainerType), dimension(:), pointer, intent(inout) :: obsArray !< observation array
    !
    nobs = this%get_num()
    if (associated(obsarray)) deallocate (obsarray)
    allocate (obsarray(nobs))
    !
    ! set observations in obsArray
    if (nobs > 0) then
      call this%set_obs_array(nobs, obsarray)
    end if
    !
    ! -- return
    return

get_obs_datum()

type(obsdatatype) function, pointer obsmodule::get_obs_datum ( class(obstype)  this, character(len=*), intent(in)  obsTypeID  )

private

Function to get an ObsDataType object for the specified observation type.

Parameters

[in]

obstypeid

observation type

Returns

observation ObsDataType

Definition at line 910 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    character(len=*), intent(in) :: obsTypeID !< observation type
    ! -- return
    type(ObsDataType), pointer :: obsDatum !< observation ObsDataType
    ! -- local
    integer(I4B) :: i
    !
    obsdatum => null()
    do i = 1, maxobstypes
      if (this%obsData(i)%ObsTypeID == obstypeid) then
        obsdatum => this%obsData(i)
        exit
      end if
    end do
    !
    if (.not. associated(obsdatum)) then
      errmsg = 'Observation type not found: '//trim(obstypeid)
      call store_error(errmsg)
      call store_error_unit(this%inUnitObs)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

obs_ad()

subroutine obsmodule::obs_ad ( class(obstype)  this )

private

Subroutine to advance each package observations by resetting the "current" value.

Definition at line 342 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    ! -- local
    integer(I4B) :: i, n
    class(ObserveType), pointer :: obsrv => null()
    !
    n = this%get_num()
    do i = 1, n
      obsrv => this%get_obs(i)
      call obsrv%ResetCurrentValue()
    end do
    !
    ! -- return
    return

obs_ar()

subroutine obsmodule::obs_ar ( class(obstype)  this )

private

Subroutine to allocate and read observations for a package. Subroutine

• reads OPTIONS block of OBS input file
• reads CONTINUOUS blocks of OBS input file

Definition at line 323 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    !
    call this%obs_ar1(this%pkgName)
    if (this%active) then
      call this%obs_ar2(this%dis)
    end if
    !
    ! -- return
    return

obs_ar1()

subroutine obsmodule::obs_ar1 ( class(obstype), intent(inout)  this, character(len=*), intent(in)  pkgname  )

private

Subroutine to read the options block in the observation input file and define output formats.

Parameters

[in]

pkgname

package name

Definition at line 565 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    character(len=*), intent(in) :: pkgname !< package name
    ! -- formats
10  format(/, 'The observation utility is active for "', a, '"')
    !
    if (this%inUnitObs > 0) then
      this%active = .true.
      !
      ! -- Indicate that OBS is active
      write (this%iout, 10) trim(pkgname)
      !
      ! -- Read Options block
      call this%read_obs_options()
      !
      ! -- define output formats
      call this%define_fmts()
    end if
    !
    ! -- return
    return

obs_ar2()

subroutine obsmodule::obs_ar2 ( class(obstype), intent(inout)  this, class(disbasetype)  dis  )

private

Subroutine to call procedure provided by package to interpret IDstring and store required data.

Parameters

dis	discretization object

Definition at line 595 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    class(DisBaseType) :: dis !< discretization object
    ! -- local
    integer(I4B) :: i
    type(ObsDataType), pointer :: obsDat => null()
    character(len=LENOBSTYPE) :: obsTypeID
    class(ObserveType), pointer :: obsrv => null()
    !
    call this%read_observations()
    ! -- allocate and set observation array
    call this%get_obs_array(this%npakobs, this%pakobs)
    !
    do i = 1, this%npakobs
      obsrv => this%pakobs(i)%obsrv
      ! -- Call IDstring processor procedure provided by package
      obstypeid = obsrv%ObsTypeId
      obsdat => this%get_obs_datum(obstypeid)
      if (associated(obsdat%ProcessIdPtr)) then
        call obsdat%ProcessIdPtr(obsrv, dis, &
                                 this%inUnitObs, this%iout)
      else
        call defaultobsidprocessor(obsrv, dis, &
                                   this%inUnitObs, this%iout)
      end if
    end do
    !
    if (count_errors() > 0) then
      call store_error_unit(this%inunitobs)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

obs_bd_clear()

subroutine obsmodule::obs_bd_clear ( class(obstype), target  this )

private

Subroutine to clear output lines in preparation for new rows of continuous observations.

Definition at line 365 of file Obs.f90.

    ! -- dummy
    class(ObsType), target :: this
    !
    call this%obsOutputList%ResetAllObsEmptyLines()
    !
    ! -- return
    return

obs_cr()

subroutine, public obsmodule::obs_cr	(	type(obstype), intent(out), pointer	obs,
		integer(i4b), intent(in), pointer	inobs
	)

Subroutine to create a new ObsType object. Soubroutine

• creates object
• allocates pointer
• initializes values

  Parameters

  [out]	obs	observation ObsType
  [in]	inobs	observation input file unit

Definition at line 224 of file Obs.f90.

    ! -- dummy
    type(ObsType), pointer, intent(out) :: obs !< observation ObsType
    integer(I4B), pointer, intent(in) :: inobs !< observation input file unit
    !
    allocate (obs)
    call obs%allocate_scalars()
    obs%inUnitObs => inobs
    !
    ! -- return
    return

Here is the caller graph for this function:

obs_da()

subroutine obsmodule::obs_da ( class(obstype), intent(inout)  this )

private

Subroutine to deallocate observation data.

Definition at line 405 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i
    class(ObserveType), pointer :: obsrv => null()
    !
    deallocate (this%active)
    deallocate (this%inputFilename)
    deallocate (this%obsData)
    !
    ! -- observation table object
    if (associated(this%obstab)) then
      call this%obstab%table_da()
      deallocate (this%obstab)
      nullify (this%obstab)
    end if
    !
    ! -- deallocate pakobs components and pakobs
    if (associated(this%pakobs)) then
      do i = 1, this%npakobs
        obsrv => this%pakobs(i)%obsrv
        call obsrv%da()
        deallocate (obsrv)
        nullify (this%pakobs(i)%obsrv)
      end do
      deallocate (this%pakobs)
    end if
    !
    ! -- deallocate obsOutputList
    call this%obsOutputList%DeallocObsOutputList()
    deallocate (this%obsOutputList)
    !
    ! -- deallocate obslist
    call this%obslist%Clear()
    !
    ! -- nullify
    nullify (this%inUnitObs)
    !
    ! -- return
    return

obs_df()

subroutine obsmodule::obs_df ( class(obstype), intent(inout)  this, integer(i4b), intent(in)  iout, character(len=*), intent(in)  pkgname, character(len=*), intent(in)  filtyp, class(disbasetype), pointer  dis  )

private

Subroutine to define some members of an ObsType object.

Parameters

[in]	iout	model list file unit
[in]	pkgname	package name
[in]	filtyp	package file type
	dis	discretization object

Definition at line 295 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    integer(I4B), intent(in) :: iout !< model list file unit
    character(len=*), intent(in) :: pkgname !< package name
    character(len=*), intent(in) :: filtyp !< package file type
    class(DisBaseType), pointer :: dis !< discretization object
    !
    this%iout = iout
    this%pkgName = pkgname
    this%filtyp = filtyp
    this%dis => dis
    !
    ! -- Initialize block parser
    call this%parser%Initialize(this%inUnitObs, this%iout)
    !
    ! -- return
    return

obs_ot()

subroutine obsmodule::obs_ot ( class(obstype), intent(inout)  this )

private

Subroutine to output observation data. Subroutine

• stores each simulated value into its ObserveType object
• writes each simulated value to it ObsOutputList object _ writes contents of ObsOutputList to output file

This procedure should NOT be called from a package's _ot procedure because the package _ot procedure may not be called every time step.

Definition at line 387 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    !
    if (this%npakobs > 0) then
      call this%write_obs_simvals()
      call this%obsOutputList%WriteAllObsLineReturns()
    end if
    !
    ! -- return
    return

read_obs_blocks()

subroutine obsmodule::read_obs_blocks ( class(obstype), intent(inout)  this, character(len=*), intent(inout)  fname  )

private

Subroutine to read CONTIGUOUS block from the observation input file.

Definition at line 986 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    character(len=*), intent(inout) :: fname
    ! -- local
    integer(I4B) :: ierr, indexobsout, numspec
    logical :: fmtd, found, endOfBlock
    character(len=LENBIGLINE) :: pnamein, fnamein
    character(len=LENHUGELINE) :: line
    character(len=LINELENGTH) :: btagfound, message, word
    character(len=LINELENGTH) :: title
    character(len=LINELENGTH) :: tag
    character(len=20) :: accarg, bin, fmtarg
    type(ObserveType), pointer :: obsrv => null()
    type(ObsOutputType), pointer :: obsOutput => null()
    integer(I4B) :: ntabrows
    integer(I4B) :: ntabcols
    !
    ! -- initialize local variables
    numspec = -1
    errmsg = ''
    !
    inquire (unit=this%parser%iuactive, name=pnamein)
    call getfilefrompath(pnamein, fnamein)
    !
    if (this%echo) then
      !
      ! -- create the observation table
      ! -- table dimensions
      ntabrows = 1
      ntabcols = 5
      !
      ! -- initialize table and define columns
      title = 'OBSERVATIONS READ FROM FILE "'//trim(fnamein)//'"'
      call table_cr(this%obstab, fnamein, title)
      call this%obstab%table_df(ntabrows, ntabcols, this%iout, &
                                finalize=.false.)
      tag = 'NAME'
      call this%obstab%initialize_column(tag, lenobsname, alignment=tableft)
      tag = 'TYPE'
      call this%obstab%initialize_column(tag, lenobstype + 12, alignment=tableft)
      tag = 'TIME'
      call this%obstab%initialize_column(tag, 12, alignment=tableft)
      tag = 'LOCATION DATA'
      call this%obstab%initialize_column(tag, lenboundname + 2, alignment=tableft)
      tag = 'OUTPUT FILENAME'
      call this%obstab%initialize_column(tag, 80, alignment=tableft)
    end if
    !
    found = .true.
    readblocks: do
      if (.not. found) exit
      !
      call this%parser%GetBlock('*', found, ierr, .true., .false., btagfound)
      if (.not. found) then
        exit readblocks
      end if
      this%blockTypeFound = btagfound
      !
      ! Get keyword, which should be FILEOUT
      call this%parser%GetStringCaps(word)
      if (word /= 'FILEOUT') then
        call store_error('CONTINUOUS keyword must be followed by '// &
                         '"FILEOUT" then by filename.')
        cycle
      end if
      !
      ! -- get name of output file
      call this%parser%GetString(fname)
      ! Fname is the output file name defined in the BEGIN line of the block.
      if (fname == '') then
        message = 'Error reading OBS input file, likely due to bad'// &
                  ' block or missing file name.'
        call store_error(message)
        cycle
      else if (this%obsOutputList%ContainsFile(fname)) then
        errmsg = 'OBS outfile "'//trim(fname)// &
                 '" is provided more than once.'
        call store_error(errmsg)
        cycle
      end if
      !
      ! -- look for BINARY option
      call this%parser%GetStringCaps(bin)
      if (bin == 'BINARY') then
        fmtarg = form
        accarg = access
        fmtd = .false.
      else
        fmtarg = 'FORMATTED'
        accarg = 'SEQUENTIAL'
        fmtd = .true.
      end if
      !
      ! -- open the output file
      numspec = 0
      call openfile(numspec, 0, fname, 'OBS OUTPUT', fmtarg, &
                    accarg, 'REPLACE')
      !
      ! -- add output file to list of output files and assign its
      !    FormattedOutput member appropriately
      call this%obsOutputList%Add(fname, numspec)
      indexobsout = this%obsOutputList%Count()
      obsoutput => this%obsOutputList%Get(indexobsout)
      obsoutput%FormattedOutput = fmtd
      !
      ! -- process lines defining observations
      select case (btagfound)
      case ('CONTINUOUS')
        !
        ! -- construct a continuous observation from each line in the block
        readblockcontinuous: do
          call this%parser%GetNextLine(endofblock)
          if (endofblock) exit
          call this%parser%GetCurrentLine(line)
          call constructobservation(obsrv, line, numspec, fmtd, &
                                    indexobsout, this%obsData, &
                                    this%parser%iuactive)
          !
          ! -- increment number of observations
          !    to be written to this output file.
          obsoutput => this%obsOutputList%Get(indexobsout)
          obsoutput%nobs = obsoutput%nobs + 1
          call addobstolist(this%obsList, obsrv)
          !
          ! -- write line to the observation table
          if (this%echo) then
            call obsrv%WriteTo(this%obstab, btagfound, fname)
          end if
        end do readblockcontinuous
      case default
        errmsg = 'Error: Observation block type not recognized: '// &
                 trim(btagfound)
        call store_error(errmsg)
      end select
    end do readblocks
    !
    ! -- finalize the observation table
    if (this%echo) then
      call this%obstab%finalize_table()
    end if
    !
    ! -- determine if error condition occurs
    if (count_errors() > 0) then
      call this%parser%StoreErrorUnit()
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

read_obs_options()

subroutine obsmodule::read_obs_options ( class(obstype)  this )

private

Subroutine to read the options block in the observation input file.

Definition at line 636 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    ! -- local
    integer(I4B) :: iin
    integer(I4B) :: ierr
    integer(I4B) :: localprecision
    integer(I4B) :: localdigits
    character(len=40) :: keyword
    character(len=LINELENGTH) :: fname
    type(ListType), pointer :: lineList => null()
    logical :: continueread, found, endOfBlock
    ! -- formats
10  format('No options block found in OBS input. Defaults will be used.')
40  format('Text output number of digits of precision set to: ', i2)
50  format('Text output number of digits set to internal representation (G0).')
60  format(/, 'Processing observation options:',/)
    !
    localprecision = 0
    localdigits = -1
    linelist => null()
    !
    ! -- Find and store file name
    iin = this%inUnitObs
    inquire (unit=iin, name=fname)
    this%inputFilename = fname
    !
    ! -- Read Options block
    continueread = .false.
    ierr = 0
    !
    ! -- get BEGIN line of OPTIONS block
    call this%parser%GetBlock('OPTIONS', found, ierr, &
                              supportopenclose=.true., blockrequired=.false.)
    if (ierr /= 0) then
      ! end of file
      errmsg = 'End-of-file encountered while searching for'// &
               ' OPTIONS in OBS '// &
               'input file "'//trim(this%inputFilename)//'"'
      call store_error(errmsg)
      call this%parser%StoreErrorUnit()
    elseif (.not. found) then
      this%blockTypeFound = ''
      if (this%iout > 0) write (this%iout, 10)
    end if
    !
    ! -- parse OPTIONS entries
    if (found) then
      write (this%iout, 60)
      readblockoptions: do
        call this%parser%GetNextLine(endofblock)
        if (endofblock) exit
        call this%parser%GetStringCaps(keyword)
        select case (keyword)
        case ('DIGITS')
          !
          ! -- error if digits already read
          if (localdigits /= -1) then
            errmsg = 'Error in OBS input: DIGITS has already been defined'
            call store_error(errmsg)
            exit readblockoptions
          end if
          !
          ! -- Specifies number of significant digits used writing simulated
          !    values to a text file. Default is stored digits.
          !
          ! -- Read integer value
          localdigits = this%parser%GetInteger()
          !
          ! -- Set localdigits to valid value: 0, or 2 to 16
          if (localdigits == 0) then
            write (this%iout, 50)
          else if (localdigits < 1) then
            errmsg = 'Error in OBS input: Invalid value for DIGITS option'
            call store_error(errmsg)
            exit readblockoptions
          else
            if (localdigits < 2) localdigits = 2
            if (localdigits > 16) localdigits = 16
            write (this%iout, 40) localdigits
          end if
        case ('PRINT_INPUT')
          this%echo = .true.
          write (this%iout, '(a)') 'The PRINT_INPUT option has been specified.'
        case default
          errmsg = 'Error in OBS input: Unrecognized option: '// &
                   trim(keyword)
          call store_error(errmsg)
          exit readblockoptions
        end select
      end do readblockoptions
    end if
    !
    if (count_errors() > 0) then
      call this%parser%StoreErrorUnit()
    end if
    !
    write (this%iout, '(1x)')
    !
    ! -- Assign type variables
    if (localprecision > 0) this%iprecision = localprecision
    if (localdigits >= 0) this%idigits = localdigits
    !
    ! -- return
    return

Here is the call graph for this function:

read_observations()

subroutine obsmodule::read_observations ( class(obstype)  this )

private

Subroutine to read the observations from the observation input file and build headers for the observation output files.

Definition at line 770 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    ! -- local
    !
    ! -- Read CONTINUOUS blocks and store observations
    call this%read_obs_blocks(this%outputFilename)
    !
    ! -- build headers
    call this%build_headers()
    !
    ! -- return
    return

saveonesimval()

subroutine obsmodule::saveonesimval ( class(obstype)  this, class(observetype), intent(inout)  obsrv, real(dp), intent(in)  simval  )

private

Subroutine to save or accumulate a simulated value to its ObserveType object.

Parameters

[in,out]	obsrv	observation ObserveType
[in]	simval	simulated value

Definition at line 454 of file Obs.f90.

    ! -- dummy
    class(ObsType) :: this
    class(ObserveType), intent(inout) :: obsrv !< observation ObserveType
    real(DP), intent(in) :: simval !< simulated value
    ! -- local
    character(len=LENOBSTYPE) :: obsTypeID
    type(ObsDataType), pointer :: obsDatum => null()
    !
    ! -- initialize variables
    obstypeid = obsrv%ObsTypeId
    obsdatum => this%get_obs_datum(obstypeid)
    !
    ! -- save current simulation time
    obsrv%CurrentTimeStepEndTime = totim
    !
    ! -- assign or accumulate simulated value
    if (obsdatum%Cumulative .and. simval /= dnodata) then
      obsrv%CurrentTimeStepEndValue = obsrv%CurrentTimeStepEndValue + simval
    else
      obsrv%CurrentTimeStepEndValue = simval
    end if
    !
    ! -- return
    return

set_obs_array()

subroutine obsmodule::set_obs_array ( class(obstype), intent(inout)  this, integer(i4b), intent(in)  nObs, type(obscontainertype), dimension(nobs), intent(inout)  obsArray  )

private

Subroutine to set values in an observation array.

Parameters

[in]	nobs	number of observations
[in,out]	obsarray	observation array

Definition at line 942 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    integer(I4B), intent(in) :: nObs !< number of observations
    type(ObsContainerType), dimension(nObs), intent(inout) :: obsArray !< observation array
    !
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: n
    type(ObserveType), pointer :: obsrv => null()
    !
    n = this%get_num()
    do i = 1, n
      obsrv => this%get_obs(i)
      obsarray(i)%obsrv => obsrv
    end do
    !
    ! -- return
    return

storeobstype()

subroutine obsmodule::storeobstype ( class(obstype), intent(inout)  this, character(len=*), intent(in)  obsrvType, logical, intent(in)  cumulative, integer(i4b), intent(out)  indx  )

private

Subroutine to store type name and related information for an observation type that belongs to a package or model in the obsData array.

Parameters

[in]	obsrvtype	observation type
[in]	cumulative	logical indicating if the observation should be accumulated
[out]	indx	observation index

Definition at line 488 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    character(len=*), intent(in) :: obsrvType !< observation type
    ! cumulative:  Accumulate simulated values for multiple boundaries
    logical, intent(in) :: cumulative !< logical indicating if the observation should be accumulated
    integer(I4B), intent(out) :: indx !< observation index
    ! -- local
    integer(I4B) :: i
    character(len=LENOBSTYPE) :: obsTypeUpper
    character(len=100) :: msg
    !
    ! -- Ensure that obsrvType is not blank
    if (obsrvtype == '') then
      msg = 'Programmer error: Invalid argument in store_obs_type.'
      call store_error(msg, terminate=.true.)
    end if
    !
    ! -- Find first unused element
    indx = -1
    do i = 1, maxobstypes
      if (this%obsData(i)%ObsTypeID /= '') cycle
      indx = i
      exit
    end do
    !
    ! -- Ensure that array size is not exceeded
    if (indx == -1) then
      msg = 'Size of obsData array is insufficient; ' &
            //'need to increase MAXOBSTYPES.'
      call store_error(msg)
      call store_error_unit(this%inUnitObs)
    end if
    !
    ! -- Convert character argument to upper case
    obstypeupper = obsrvtype
    call upcase(obstypeupper)
    !
    ! -- Assign members
    this%obsData(indx)%ObsTypeID = obstypeupper
    this%obsData(indx)%Cumulative = cumulative
    !
    ! -- return
    return

Here is the call graph for this function:

write_obs_simvals()

subroutine obsmodule::write_obs_simvals ( class(obstype), intent(inout)  this )

private

Subroutine to write observation data for a time step for each observation to the observation output file.

Definition at line 1143 of file Obs.f90.

    ! -- dummy
    class(ObsType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: iprec
    integer(I4B) :: numobs
    character(len=20) :: fmtc
    real(DP) :: simval
    class(ObserveType), pointer :: obsrv => null()
    !
    ! Write simulated values for observations
    iprec = this%iprecision
    fmtc = this%obsfmtcont
    ! -- iterate through all observations
    numobs = this%obsList%Count()
    do i = 1, numobs
      obsrv => this%get_obs(i)
      ! -- continuous observation
      simval = obsrv%CurrentTimeStepEndValue
      if (obsrv%FormattedOutput) then
        call write_fmtd_obs(fmtc, obsrv, this%obsOutputList, simval)
      else
        call write_unfmtd_obs(obsrv, iprec, this%obsOutputList, simval)
      end if
    end do
    !
    ! --return
    return

Here is the call graph for this function: