B.5.1 Initialize_Character Procedure

The main documentation of the Initialize_Character Procedure contains additional explanation of this code listing.

  subroutine Initialize_Character_0 (C, status)

    ! Use association information.

    use Caesar_Flags_Module, only: initialize_character_flag

    ! Output variables.

    type(character,*), intent(out) :: C  ! Variable to be initialized.
    type(Status_type), intent(out), optional :: status  ! Exit status.

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ! Verify requirements - none.

    ! Initialize to flag value.

    C = initialize_character_flag

    ! No errors for initialization possible for scalars.

    if (PRESENT(status)) status = 'Success'

    ! Verify guarantees - none.

    return
  end subroutine Initialize_Character_0

  define([REPLICATE_ROUTINE],[
    subroutine Initialize_Character_$1 (C REP_ARGS([dim[]i]), status)
  
      ! Use association information.
  
      use Caesar_Flags_Module, only: initialize_character_flag
  
      ! Input variable.
  
      REP_DECLARE([type(integer), intent(in)], [dim[]i]) ! Array dimensions.
  
      ! Input/Output variable.
  
      type(character,*,$1) :: C            ! Variable to be initialized.
  
      ! Output variable.
  
      type(Status_type), intent(out), optional :: status  ! Exit status.
  
      ! Internal variable.
  
      type(integer) :: allocate_status     ! Allocation Status.
  
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
      ! Verify requirements.
  
      ! The association status of a unallocated pointer is officially 
      ! undefined according to the Fortran standard. With most compilers,
      ! the status is unassociated.
      ifelse(COMPILER, NAGWare,
        [], [
        VERIFY(.not.ASSOCIATED(C), 0)   ! C starts out unassociated.
      ])

      ! Allocation (for arrays only).
      
      REP_ALLOCATE([C], [dim[]i], [allocate_status])
  
      ! Initialize to flag value.
  
      C = initialize_character_flag
  
      ! Verify guarantees and/or set status flag.
  
      if (PRESENT(status)) then
        WARN_IF(allocate_status /= 0, 3)  ! Allocation error check.
        WARN_IF(.not.ASSOCIATED(C),3)     ! C is now associated.
        if (allocate_status == 0 .and. ASSOCIATED(C)) then
          status = 'Success'
        else
          status = 'Memory Error'
        end if
      else
        VERIFY(allocate_status == 0, 0)  ! Allocation error check.
        VERIFY(ASSOCIATED(C),0)          ! C is now associated.
      end if
  
      return
    end subroutine Initialize_Character_$1
  ])

  REPLICATE_ARRAYS