B.1 Status Class Code Listing

The main documentation of the Status Class contains additional explanation of this code listing.

!
! Author: Michael L. Hall
!         P.O. Box 1663, MS-D413, LANL
!         Los Alamos, NM 87545
!         ph: 505-665-4312
!         email: Hall@LANL.gov
! 
! Created on: 03/23/99
! CVS Info:   $Id: status.F90,v 7.7 2007/01/23 19:30:53 hall Exp $

module Caesar_Status_Class

  ! Global use associations - none.

  ! Start up with everything untyped and private.

  implicit none
  private

  ! Public procedures.

  public :: Initialize, Finalize, Valid_State
  public :: Assignment (=), Operator (==), Operator (/=), Consolidate, &
            Equal, Error, Get, Normal, Not_Equal, Set, Warning

  interface Initialize
    module procedure Initialize_Status
    module procedure Initialize_Status_Vector
  end interface

  interface Finalize
    module procedure Finalize_Status
    module procedure Finalize_Status_Vector
  end interface

  interface Valid_State
    module procedure Valid_State_Status
    module procedure Valid_State_Status_Vector
  end interface

  interface Assignment (=)
    module procedure Set_Status
    module procedure Get_Status_Output
    module procedure Consolidate_Status
  end interface

  interface Operator (==)
    module procedure Status_Equal_Status
    module procedure Status_Equal_Character
    module procedure Character_Equal_Status
  end interface

  interface Operator (/=)
    module procedure Status_Not_Equal_Status
    module procedure Status_Not_Equal_Character
    module procedure Character_Not_Equal_Status
  end interface

  interface Consolidate
    module procedure Consolidate_Status
  end interface

  interface Equal
    module procedure Status_Equal_Status
    module procedure Status_Equal_Character
    module procedure Character_Equal_Status
  end interface

  interface Error
    module procedure Error_Status
  end interface

  interface Get
    module procedure Get_Status_Output
  end interface

  interface Normal
    module procedure Normal_Status
  end interface

  interface Not_Equal
    module procedure Status_Not_Equal_Status
    module procedure Status_Not_Equal_Character
    module procedure Character_Not_Equal_Status
  end interface

  interface Set
    module procedure Set_Status
  end interface

  interface Warning
    module procedure Warning_Status
  end interface

  ! Public type definitions.

  public :: Status_type

  type Status_type
    private
    type(integer) :: status
  end type Status_type

  ! Global class variables.

  type(integer), parameter :: &
    NFlags=10,                &  ! Number of Flag types.
    output_length = 35,       &  ! Length of the output string.
    selector_length = 16,     &  ! Length of the selector string.
    severity_length = 7          ! Length of the severity string.

  type Flag       ! Status flag derived type.
    type(character,selector_length) :: selector
    type(character,output_length) :: output_string
    type(character,severity_length) :: severity
  end type Flag

  !---------------------------------------------------------------------------
  ! This is the main list of possible flags (or values for a status variable).
  !
  ! Note: when adding a new flag below, remember to:
  !
  !   - update NFlags above, and
  !   - add the new selector to the list in the 
  !     Set_Status routine comments.
  !
  ! Flag order is unimportant.

  type(Flag), dimension(1:NFlags), parameter ::                                   &
    status_flag = (/                                                              &
          ! Selector            Output String                          Severity
      Flag('Unset           ', 'Status Initialized But Unset       ', 'Normal '), &
      Flag('Success         ', 'Successful Procedure Execution     ', 'Normal '), &
      Flag('Multiple Error  ', 'Multiple Error Types in Procedure  ', 'Error  '), &
      Flag('Multiple Warning', 'Multiple Warning Types in Procedure', 'Warning'), &
      Flag('Memory Warning  ', 'Memory Allocation Warning          ', 'Warning'), &
      Flag('Memory Error    ', 'Memory Allocation Error            ', 'Error  '), &
      Flag('File Error      ', 'File Access Error                  ', 'Error  '), &
      Flag('CGNS Error      ', 'CGNS Error                         ', 'Error  '), &
      Flag('CGNS No Node    ', 'CGNS NODE_NOT_FOUND Error          ', 'Error  '), &
      Flag('CGNS Bad Path   ', 'CGNS INCORRECT_PATH Error          ', 'Error  ')  &
    /)
  !---------------------------------------------------------------------------

contains

The Status Class contains the following routines which are listed in separate sections:

Initialize_Status

Initialize_Status_Vector

Finalize_Status

Finalize_Status_Vector

Valid_State_Status

Valid_State_Status_Vector

Error_Status

Warning_Status

Normal_Status

Set_Status

Get_Status_Output

Status_Equal_Status

Status_Not_Equal_Status

Status_Equal_Character

Status_Not_Equal_Character

Character_Equal_Status

Character_Not_Equal_Status

Consolidate_Status

end module Caesar_Status_Class