alloc_status Subroutine

public subroutine alloc_status(istat_, message_, op_, unit_)

check the status after allocation

Arguments

Type IntentOptional Attributes Name
integer(kind=int32) :: istat_

result of stat=istat in (de)allocate
character(len=*), intent(in) :: message_

a message to be written
character(len=1), intent(in) :: op_

'a' for allocation, 'd' for deallocation
integer(kind=int32), intent(in), optional :: unit_

optional, unit where the message will be written

Calls

proc~~alloc_status~~CallsGraph proc~alloc_status alloc_status proc~write_error write_error proc~alloc_status->proc~write_error proc~write_message write_message proc~write_error->proc~write_message

Contents

Variables

Source Code

alloc_status

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: add_prefix_

Source Code

      subroutine alloc_status(istat_, message_, op_, unit_)
         !! check the status after allocation
         !---------------------------------------------------------------------!
         integer(int32)                       :: istat_
            !! result of stat=istat in (de)allocate
         character(len = *), intent(in)       :: message_
            !! a message to be written
         character(len = 1), intent(in)       :: op_
            !! 'a' for allocation, 'd' for deallocation
         integer(int32), optional, intent(in) :: unit_
            !! optional, unit where the message will be written
         !---------------------------------------------------------------------!
         character(len = :), allocatable :: add_prefix_
         !---------------------------------------------------------------------!
         add_prefix_ = ''
         if (istat_ /= 0) then
            select case(op_)
               case('a')
                  add_prefix_ = 'memory allocation: '//trim(message_)
               case('d')
                  add_prefix_ = 'memory deallocation: '//trim(message_)
               case default
                  call write_error                                             &
                         ('Incorrect op_ argument in alloc_status subroutine ('&
                          //trim(op_)//')')
            end select
            call write_error(add_prefix_, unit_)
         endif
         !---------------------------------------------------------------------!
      end subroutine alloc_status