PDAFomi_obs_l Module

PDAF-OMI routines for local observations

This module contains generic routines for several observation-related operations for local filters. The routines are

  • PDAFomi_set_debug_flag \n Set or unset the debugging flag for PDAFomi routines
  • PDAFomi_init_dim_obs_l \n Initialize dimension of local obs. vetor and arrays for local observations
  • PDAFomi_cnt_dim_obs_l \n Set dimension of local obs. vector with isotropic localization
  • PDAFomi_cnt_dim_obs_l_noniso \n Set dimension of local obs. vector with nonisotropic localization
  • PDAFomi_init_obsarrays_l \n Initialize arrays for the index of a local observation in the full observation vector and its corresponding distance.
  • PDAFomi_init_obsarrays_l_noniso \n Initialize arrays for the index of a local observation in the full observation vector and its corresponding distance with onoisotrppic localization.
  • PDAFomi_g2l_obs \n Initialize local observation vector from full observation vector
  • PDAFomi_init_obs_l \n Initialize the local vector of observations
  • PDAFomi_prodRinvA_l \n Multiply an intermediate matrix of the local filter analysis with the inverse of the observation error covariance matrix and apply observation localization
  • PDAFomi_prodRinvA_hyb_l \n Multiply an intermediate matrix of the local filter analysis with the inverse of the observation error covariance matrix and apply observation localization. In addition apply the hybrid weight
  • PDAFomi_init_obsvar_l \n Compute mean observation error variance
  • PDAFomi_likelihood_l \n Compute local likelihood for an ensemble member
  • PDAFomi_likelihood_hyb_l \n Compute local likelihood for an ensemble member taking into account a hybrid weight for tempering
  • PDAFomi_localize_covar_iso \n Apply covariance isotropic localization in LEnKF
  • PDAFomi_localize_covar_noniso \n Apply non-isotropic covariance localization in LEnKF
  • PDAFomi_g2l_obs_internal \n Internal routine to initialize local observation vector from full observation vector (used by PDAFomi_init_obs_l and PDAFomi_g2l_obs)
  • PDAFomi_comp_dist2 \n Compute squared distance
  • PDAFomi_check_dist2 \n Compute and check distance for isotropic localization
  • PDAFomi_check_dist2_noniso \n Compute and check distance for non-isotropic localization
  • PDAFomi_weights_l \n Compute a vector of localization weights
  • PDAFomi_deallocate_obs \n Deallocate arrays in observation type
  • PDAFomi_dealloc \n Deallocate arrays in all observation types
  • PDAFomi_omit_by_innovation_l !! Exclude observations if innovation is too large (thisobs%inno_exclude)

Revision history: * 2019-06 - Lars Nerger - Initial code * Later revisions - see repository log

Set debugging flag

This routine sets the debug flag for PDAF-OMI. One can set the flag dependent on the local analysis domain, the MPI rank, or the OpenMP thread ID, or and combination of them.

For debugval>0 additional information is written by the OMI routine to stdout. One should activate the debugging before calling some selected routine(s) and deactivate it with debugval=0 afterwards. This allows for a targeted checking of the functionality.

Revision history: * 2019-09 - Lars Nerger - Initial code * Later revisions - see repository log



Variables

Type Visibility Attributes Name Initial
type(obs_arr_l), public, ALLOCATABLE :: obs_l_all(:)
integer, public :: firstobs = 0
integer, public :: offset_obs_l = 0

Interfaces

public interface PDAFomi_init_dim_obs_l

  • public subroutine PDAFomi_init_dim_obs_l_iso(thisobs_l, thisobs, coords_l, locweight, cradius, sradius, cnt_obs_l)

    Set dimension of local obs. vector and local obs. arrays

    This routine sets the number of local observations for the current observation type for the local analysis domain with coordinates COORD_l and localization cut-off radius CRADIUS. Further the routine initializes arrays for the index of a local observation in the full observation vector and its corresponding distance. The operation are performed by calling the routines cnt_dim_obs_l and init_obsarrays_l.

    Revision history: * 2019-06 - Lars Nerger - Initial code from restructuring observation routines * Later revisions - see repository log

    Arguments

    Type IntentOptional Attributes Name
    type(obs_l), intent(inout), TARGET :: thisobs_l
    type(obs_f), intent(inout) :: thisobs
    real, intent(in) :: coords_l(:)
    integer, intent(in) :: locweight
    real, intent(in) :: cradius
    real, intent(in) :: sradius
    integer, intent(inout) :: cnt_obs_l
  • public subroutine PDAFomi_init_dim_obs_l_noniso(thisobs_l, thisobs, coords_l, locweight, cradius, sradius, cnt_obs_l)

    Set dimension of local obs. vector and local obs. arrays (non-isotropic)

    This routine sets the number of local observations for the current observation type for the local analysis domain with coordinates COORD_l and a vector of localization cut-off radii CRADIUS. Further the routine initializes arrays for the index of a local observation in the full observation vector and its corresponding distance. The operation are performed by calling the routines cnt_dim_obs_l and init_obsarrays_l.

    Revision history: * 2024-02 - Lars Nerger - Initial code from restructuring observation routines * Later revisions - see repository log

    Arguments

    Type IntentOptional Attributes Name
    type(obs_l), intent(inout), TARGET :: thisobs_l
    type(obs_f), intent(inout) :: thisobs
    real, intent(in) :: coords_l(:)
    integer, intent(in) :: locweight
    real, intent(in) :: cradius(:)
    real, intent(in) :: sradius(:)
    integer, intent(inout) :: cnt_obs_l
  • public subroutine PDAFomi_init_dim_obs_l_noniso_locweights(thisobs_l, thisobs, coords_l, locweights, cradius, sradius, cnt_obs_l)

    Set dimension of local obs. vector and local obs. arrays

    This routine is a variant of PDAFomi_init_dim_obs_l_noniso with support for a vector of localization weights. This is used to specify different localization functions for the vertical and horizontal directions. The routine only stores the value of locweights(2) for the vertical and calls PDAFomi_init_dim_obs_l_iso.

    Revision history: * 2024-04 - Lars Nerger - Initial code * Later revisions - see repository log

    Arguments

    Type IntentOptional Attributes Name
    type(obs_l), intent(inout), TARGET :: thisobs_l
    type(obs_f), intent(inout) :: thisobs
    real, intent(in) :: coords_l(:)
    integer, intent(in) :: locweights(:)
    real, intent(in) :: cradius(:)
    real, intent(in) :: sradius(:)
    integer, intent(inout) :: cnt_obs_l

public interface PDAFomi_localize_covar

  • public subroutine PDAFomi_localize_covar_iso(thisobs, dim, locweight, cradius, sradius, coords, HP, HPH)

    Apply covariance localization

    This routine applies a localization matrix B to the matrices HP and HPH^T of the localized EnKF.

    Revision history: * 2020-03 - Lars Nerger - Initial code from restructuring observation routines * Later revisions - see repository log

    Arguments

    Type IntentOptional Attributes Name
    type(obs_f), intent(in) :: thisobs
    integer, intent(in) :: dim
    integer, intent(in) :: locweight
    real, intent(in) :: cradius
    real, intent(in) :: sradius
    real, intent(in) :: coords(:,:)
    real, intent(inout) :: HP(:,:)
    real, intent(inout) :: HPH(:,:)
  • public subroutine PDAFomi_localize_covar_noniso(thisobs, dim, locweight, cradius, sradius, coords, HP, HPH)

    Apply covariance localization

    This routine applies a localization matrix B to the matrices HP and HPH^T of the localized EnKF. This variant is for non-iceotropic localization

    Revision history: * 2020-03 - Lars Nerger - Initial code from restructuring observation routines * Later revisions - see repository log

    Arguments

    Type IntentOptional Attributes Name
    type(obs_f), intent(in) :: thisobs
    integer, intent(in) :: dim
    integer, intent(in) :: locweight
    real, intent(in) :: cradius(:)
    real, intent(in) :: sradius(:)
    real, intent(in) :: coords(:,:)
    real, intent(inout) :: HP(:,:)
    real, intent(inout) :: HPH(:,:)

Derived Types

type, public ::  obs_l

Components

Type Visibility Attributes Name Initial
integer, public :: dim_obs_l
integer, public :: off_obs_l
integer, public, ALLOCATABLE :: id_obs_l(:)
real, public, ALLOCATABLE :: distance_l(:)
real, public, ALLOCATABLE :: cradius_l(:)
real, public, ALLOCATABLE :: sradius_l(:)
real, public, ALLOCATABLE :: ivar_obs_l(:)
real, public, ALLOCATABLE :: dist_l_v(:)
integer, public :: locweight
integer, public :: locweight_v = 0
integer, public :: nradii
real, public, ALLOCATABLE :: cradius(:)
real, public, ALLOCATABLE :: sradius(:)

type, public ::  obs_arr_l

Components

Type Visibility Attributes Name Initial
type(obs_l), public, POINTER :: ptr

Subroutines

public subroutine PDAFomi_set_debug_flag(debugval)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: debugval

public subroutine PDAFomi_init_dim_obs_l_iso(thisobs_l, thisobs, coords_l, locweight, cradius, sradius, cnt_obs_l)

Set dimension of local obs. vector and local obs. arrays

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout), TARGET :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)
integer, intent(in) :: locweight
real, intent(in) :: cradius
real, intent(in) :: sradius
integer, intent(inout) :: cnt_obs_l

public subroutine PDAFomi_init_dim_obs_l_noniso(thisobs_l, thisobs, coords_l, locweight, cradius, sradius, cnt_obs_l)

Set dimension of local obs. vector and local obs. arrays (non-isotropic)

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout), TARGET :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)
integer, intent(in) :: locweight
real, intent(in) :: cradius(:)
real, intent(in) :: sradius(:)
integer, intent(inout) :: cnt_obs_l

public subroutine PDAFomi_init_dim_obs_l_noniso_locweights(thisobs_l, thisobs, coords_l, locweights, cradius, sradius, cnt_obs_l)

Set dimension of local obs. vector and local obs. arrays

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout), TARGET :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)
integer, intent(in) :: locweights(:)
real, intent(in) :: cradius(:)
real, intent(in) :: sradius(:)
integer, intent(inout) :: cnt_obs_l

public subroutine PDAFomi_cnt_dim_obs_l(thisobs_l, thisobs, coords_l)

Set dimension of local observation vector

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)

public subroutine PDAFomi_cnt_dim_obs_l_noniso(thisobs_l, thisobs, coords_l)

Set dimension of local observation vector for nonisotropic localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)

public subroutine PDAFomi_init_obsarrays_l(thisobs_l, thisobs, coords_l, off_obs_l_all)

Initialize local arrays for an observation

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)
integer, intent(inout) :: off_obs_l_all

public subroutine PDAFomi_init_obsarrays_l_noniso(thisobs_l, thisobs, coords_l, off_obs_l_all)

Initialize local arrays for an observation for nonisotropic localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: coords_l(:)
integer, intent(inout) :: off_obs_l_all

public subroutine PDAFomi_g2l_obs(thisobs_l, thisobs, obs_f_all, obs_l_all)

Initialize local observation vector

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: obs_f_all(:)
real, intent(inout) :: obs_l_all(:)

public subroutine PDAFomi_init_obs_l(thisobs_l, thisobs, obs_l_all)

Initialize local observation vector and inverse error variance

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(inout) :: obs_l_all(:)

public subroutine PDAFomi_init_obsvar_l(thisobs_l, thisobs, meanvar_l, cnt_obs_l)

Compute mean observation error variance

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(inout) :: meanvar_l
integer, intent(inout) :: cnt_obs_l

public subroutine PDAFomi_prodRinvA_l(thisobs_l, thisobs, nobs_all, ncols, A_l, C_l, verbose)

Compute product of inverse of R with some matrix

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
integer, intent(in) :: nobs_all
integer, intent(in) :: ncols
real, intent(inout) :: A_l(:,:)
real, intent(out) :: C_l(:,:)
integer, intent(in) :: verbose

public subroutine PDAFomi_prodRinvA_hyb_l(thisobs_l, thisobs, nobs_all, ncols, gamma, A_l, C_l, verbose)

Compute product of inverse of R with some matrix and hybrid weight

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
integer, intent(in) :: nobs_all
integer, intent(in) :: ncols
real, intent(in) :: gamma
real, intent(inout) :: A_l(:,:)
real, intent(out) :: C_l(:,:)
integer, intent(in) :: verbose

public subroutine PDAFomi_likelihood_l(thisobs_l, thisobs, resid_l, lhood_l, verbose)

Compute local likelihood for an ensemble member

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(inout) :: resid_l(:)
real, intent(inout) :: lhood_l
integer, intent(in) :: verbose

public subroutine PDAFomi_likelihood_hyb_l(thisobs_l, thisobs, resid_l, gamma, lhood_l, verbose)

Compute local likelihood for an ensemble member using hybrid weight

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(inout) :: resid_l(:)
real, intent(in) :: gamma
real, intent(inout) :: lhood_l
integer, intent(in) :: verbose

public subroutine PDAFomi_localize_covar_iso(thisobs, dim, locweight, cradius, sradius, coords, HP, HPH)

Apply covariance localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(in) :: thisobs
integer, intent(in) :: dim
integer, intent(in) :: locweight
real, intent(in) :: cradius
real, intent(in) :: sradius
real, intent(in) :: coords(:,:)
real, intent(inout) :: HP(:,:)
real, intent(inout) :: HPH(:,:)

public subroutine PDAFomi_localize_covar_noniso_locweights(thisobs, dim, locweights, cradius, sradius, coords, HP, HPH)

Apply covariance localization: 2+1D factorized with vertical localization weight

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(inout) :: thisobs
integer, intent(in) :: dim
integer, intent(in) :: locweights(:)
real, intent(in) :: cradius(:)
real, intent(in) :: sradius(:)
real, intent(in) :: coords(:,:)
real, intent(inout) :: HP(:,:)
real, intent(inout) :: HPH(:,:)

public subroutine PDAFomi_localize_covar_noniso(thisobs, dim, locweight, cradius, sradius, coords, HP, HPH)

Apply covariance localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(in) :: thisobs
integer, intent(in) :: dim
integer, intent(in) :: locweight
real, intent(in) :: cradius(:)
real, intent(in) :: sradius(:)
real, intent(in) :: coords(:,:)
real, intent(inout) :: HP(:,:)
real, intent(inout) :: HPH(:,:)

public subroutine PDAFomi_g2l_obs_internal(thisobs_l, obs_f_one, offset_obs_l_all, obs_l_all)

Initialize local observation vector

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
real, intent(in) :: obs_f_one(:)
integer, intent(in) :: offset_obs_l_all
real, intent(inout) :: obs_l_all(:)

public subroutine PDAFomi_comp_dist2(thisobs, coordsA, coordsB, distance2, verbose)

Compute square distance between two locations

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(in) :: thisobs
real, intent(in) :: coordsA(:)
real, intent(in) :: coordsB(:)
real, intent(out) :: distance2
integer, intent(in) :: verbose

public subroutine PDAFomi_check_dist2(thisobs, thisobs_l, coordsA, coordsB, distance2, checkdist, verbose, cnt_obs)

Check distance in case of isotropic localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(in) :: thisobs
type(obs_l), intent(in) :: thisobs_l
real, intent(in) :: coordsA(:)
real, intent(in) :: coordsB(:)
real, intent(out) :: distance2
logical, intent(out) :: checkdist
integer, intent(in) :: verbose
integer, intent(inout) :: cnt_obs

public subroutine PDAFomi_check_dist2_noniso(thisobs, thisobs_l, coordsA, coordsB, distance2, dists, cradius, sradius, checkdist, verbose, cnt_obs)

Check distance in case of nonisotropic localization

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(in) :: thisobs
type(obs_l), intent(in) :: thisobs_l
real, intent(in) :: coordsA(:)
real, intent(in) :: coordsB(:)
real, intent(out) :: distance2
real, intent(inout) :: dists(:)
real, intent(out) :: cradius
real, intent(inout) :: sradius
logical, intent(out) :: checkdist
integer, intent(in) :: verbose
integer, intent(inout) :: cnt_obs

public subroutine PDAFomi_weights_l(verbose, nobs_l, ncols, locweight, cradius, sradius, matA, ivar_obs_l, dist_l, weight_l)

Compute weight vector for localization

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: verbose
integer, intent(in) :: nobs_l
integer, intent(in) :: ncols
integer, intent(in) :: locweight
real, intent(in) :: cradius(:)
real, intent(in) :: sradius(:)
real, intent(in) :: matA(:,:)
real, intent(in) :: ivar_obs_l(:)
real, intent(in) :: dist_l(:)
real, intent(out) :: weight_l(:)

public subroutine PDAFomi_weights_l_sgnl(verbose, nobs_l, ncols, locweight, cradius, sradius, matA, ivar_obs_l, dist_l, weight_l)

Compute weight vector for localization

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: verbose
integer, intent(in) :: nobs_l
integer, intent(in) :: ncols
integer, intent(in) :: locweight
real, intent(in) :: cradius
real, intent(in) :: sradius
real, intent(in) :: matA(:,:)
real, intent(in) :: ivar_obs_l(:)
real, intent(in) :: dist_l(:)
real, intent(out) :: weight_l(:)

public subroutine PDAFomi_deallocate_obs(thisobs)

Deallocate arrays in observation type

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_f), intent(inout) :: thisobs

public subroutine PDAFomi_omit_by_inno_l(thisobs_l, thisobs, inno_l, obs_l_all, obsid, cnt_all, verbose)

Exclude observations for too high innovation

Read more…

Arguments

Type IntentOptional Attributes Name
type(obs_l), intent(inout) :: thisobs_l
type(obs_f), intent(inout) :: thisobs
real, intent(in) :: inno_l(:)
real, intent(in) :: obs_l_all(:)
integer, intent(in) :: obsid
integer, intent(inout) :: cnt_all
integer, intent(in) :: verbose

public subroutine PDAFomi_obsstats_l(screen)

Get statistics on local observations

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: screen

public subroutine PDAFomi_dealloc()

Deallocate arrays in all observation types

Read more…

Arguments

None