iAtm_Define.f90

Go to the documentation of this file.

!
! iAtm_Define
!
! Module for defining the Atmosphere module internal data object
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 07-Apr-2009
!                       paul.vandelst@noaa.gov
!

MODULE iatm_define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds     , ONLY: fp
  USE message_handler, ONLY: success, failure, display_message
  USE crtm_parameters, ONLY: zero, set
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Structures
  PUBLIC :: iatm_type
  ! Procedures
  PUBLIC :: iatm_associated
  PUBLIC :: iatm_create
  PUBLIC :: iatm_destroy


  ! -----------------
  ! Module parameters
  ! -----------------
  ! Version Id for the module
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: iAtm_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Message string length
  INTEGER, PARAMETER :: ml = 256


  ! --------------------
  ! Structure definition
  ! --------------------
  !:tdoc+:
  TYPE :: iatm_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Dimensions
    INTEGER :: n_layers    = 0  ! K dimension
    INTEGER :: n_absorbers = 0  ! J dimension
    ! Level arrays
    REAL(fp), ALLOCATABLE :: pl(:)    ! 0:K
    REAL(fp), ALLOCATABLE :: tl(:)    ! 0:K
    REAL(fp), ALLOCATABLE :: al(:,:)  ! 0:K x J
    ! Layer arrays
    REAL(fp), ALLOCATABLE :: p(:)    ! K
    REAL(fp), ALLOCATABLE :: t(:)    ! K
    REAL(fp), ALLOCATABLE :: a(:,:)  ! K x J
    ! Save variables
    REAL(fp)              :: pln_save = zero
    REAL(fp)              :: tln_save = zero
    REAL(fp), ALLOCATABLE :: aln_save(:)  ! J
    REAL(fp)              :: plint_save = zero
    REAL(fp)              :: tlint_save = zero
    REAL(fp), ALLOCATABLE :: alint_save(:)  ! J
    REAL(fp), ALLOCATABLE :: a_save(:,:)    ! K x J
    ! Interpolating polynomials
    REAL(fp) :: ilpoly = zero  ! Interpolating polynomial for extra levels to user Pl(0)
    REAL(fp) :: elpoly = zero  ! Extrapolating polynomial for user "layer 0" values
  END TYPE iatm_type
  !:tdoc-:
  
  
CONTAINS


!##################################################################################
!##################################################################################
!##
!##                          ## PUBLIC MODULE ROUTINES ##
!##
!##################################################################################
!##################################################################################

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       iAtm_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of an iAtm object.
!
! CALLING SEQUENCE:
!       Status = iAtm_Associated( iAtm )
!
! OBJECTS:
!       iAtm:      Internal iAtm object which is to have its member's
!                  status tested.
!                  UNITS:      N/A
!                  TYPE:       iAtm_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:    The return value is a logical value indicating the
!                  status of the iAtm members.
!                  .TRUE.  - if ANY of the allocatable or
!                            pointer members are in use.
!                  .FALSE. - if ALL of the allocatable or
!                            pointer members are not in use.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION iatm_associated( self ) RESULT( Status )
    TYPE(iatm_type), INTENT(IN) :: self
    LOGICAL :: status
    status = self%Is_Allocated
  END FUNCTION iatm_associated


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Destroy_iAtm
! 
! PURPOSE:
!       Elemental subroutine to re-initialize iAtm objects.
!
! CALLING SEQUENCE:
!       CALL iAtm_Destroy( iAtm )
!
! OBJECTS:
!       iAtm:         Re-initialized internal iAtm object.
!                     UNITS:      N/A
!                     TYPE:       iAtm_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE iatm_destroy( self )
    TYPE(iatm_type), INTENT(OUT) :: self
    self%Is_Allocated = .false.
  END SUBROUTINE iatm_destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       iAtm_Create
! 
! PURPOSE:
!       Elemental subroutine to create an instance of the iAtm object.
!
! CALLING SEQUENCE:
!       CALL iAtm_Create( iAtm       , &
!                         n_Layers   , &
!                         n_Absorbers, &
!                         iAtm         )
!
! OBJECTS:
!       iAtm:         Internal iAtm structure.
!                     UNITS:      N/A
!                     TYPE:       iAtm_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Layers:     Number of layers dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar or same as iAtm object
!                     ATTRIBUTES: INTENT(IN)
!
!       n_Absorbers:  Number of absorbers dimension.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar or same as iAtm object
!                     ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE iatm_create( &
    self       , &  ! Output
    n_Layers   , &  ! Input
    n_Absorbers  )  ! Input
    ! Arguments
    TYPE(iatm_type), INTENT(OUT) :: self
    INTEGER        , INTENT(IN)  :: n_layers    
    INTEGER        , INTENT(IN)  :: n_absorbers 
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_layers < 1 .OR. n_absorbers < 1 ) RETURN

    ! Perform the allocation
    ALLOCATE( self%pl(0:n_layers), self%tl(0:n_layers), self%al(0:n_layers, 1:n_absorbers), &
              self%p(1:n_layers) , self%t(1:n_layers) , self%a(1:n_layers, 1:n_absorbers) , &
              self%aln_save(1:n_absorbers), &
              self%alint_save(1:n_absorbers), &
              self%a_save(1:n_layers,1:n_absorbers), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN

    ! Initialise
    ! ...Dimensions
    self%n_Layers    = n_layers
    self%n_Absorbers = n_absorbers
    ! ...Arrays
    self%pl         = zero
    self%tl         = zero
    self%al         = zero
    self%p          = zero
    self%t          = zero
    self%a          = zero
    self%aln_save   = zero
    self%alint_save = zero
    self%a_save     = zero
    
    ! Set allocation indicator
    self%Is_Allocated = .true.
  END SUBROUTINE iatm_create

END MODULE iatm_define