ncdw_realloc.F90

Go to the documentation of this file.

module ncdw_realloc
    use ncd_kinds, only: i_byte, i_short, i_long, i_llong, r_single, &
        r_double
    use ncdw_climsg, only: nclayer_error
#ifdef _DEBUG_MEM_
    use ncdw_climsg, only: nclayer_debug
#endif
    
    implicit none
    
    ! This file provides the interface wrapper for the array
    ! reallocation subroutines. This is so that others can simply
    ! call nc_diag_realloc with the necessary arguments, instead of
    ! having to call the specific nc_diag_realloc_* subroutines.
    
    interface nc_diag_realloc
        module procedure nc_diag_realloc_byte, &
            nc_diag_realloc_short, nc_diag_realloc_long, &
            nc_diag_realloc_llong, nc_diag_realloc_rsingle, &
            nc_diag_realloc_rdouble, nc_diag_realloc_string, &
            nc_diag_realloc_logical
    end interface nc_diag_realloc
    
    contains
        ! nc_diag_realloc_byte(arr, addl_num_entries)
        !   input:
        !     integer(i_byte), dimension(:)  :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_byte(arr, addl_num_entries)
            integer(i_byte), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            integer(i_byte), dimension(:), allocatable   :: tmp
            integer(i_llong)                             :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
        end subroutine nc_diag_realloc_byte
        
        ! nc_diag_realloc_short(arr, addl_num_entries)
        !   input:
        !     integer(i_short), dimension(:) :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_short(arr, addl_num_entries)
            integer(i_short), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            integer(i_short), dimension(:), allocatable   :: tmp
            integer(i_llong)                              :: new_size
            
            integer(i_byte)                               :: alloc_err
            character(len=100)                            :: err_msg
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
        end subroutine nc_diag_realloc_short
        
        ! nc_diag_realloc_long(arr, addl_num_entries)
        !   input:
        !     integer(i_long), dimension(:)  :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_long(arr, addl_num_entries)
            integer(i_long), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            integer(i_long), dimension(:), allocatable   :: tmp
            integer(i_llong)                             :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
#ifdef _DEBUG_MEM_
            call nclayer_debug("Reallocating long array...")
#endif
            
            new_size = size(arr) + addl_num_entries
            
#ifdef _DEBUG_MEM_
            print *, "REALLOCATOR: new_size is ", new_size
#endif
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
            
#ifdef _DEBUG_MEM_
            print *, "REALLOCATOR: final actual size is ", size(arr)
            call nclayer_debug("Realloc finished for long")
#endif
        end subroutine nc_diag_realloc_long
        
        ! nc_diag_realloc_llong(arr, addl_num_entries)
        !   input:
        !     integer(i_llong), dimension(:)  :: arr
        !         array to reallocate
        !     integer(i_llong), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_llong(arr, addl_num_entries)
            integer(i_llong), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            integer(i_llong), dimension(:), allocatable   :: tmp
            integer(i_llong)                             :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
#ifdef _DEBUG_MEM_
            call nclayer_debug("Reallocating long array...")
#endif
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
            
#ifdef _DEBUG_MEM_
            call nclayer_debug("Realloc finished for long")
#endif
        end subroutine nc_diag_realloc_llong
        
        ! nc_diag_realloc_rsingle(arr, addl_num_entries)
        !   input:
        !     real(r_single), dimension(:)   :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_rsingle(arr, addl_num_entries)
            real(r_single), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            real(r_single), dimension(:), allocatable    :: tmp
            integer(i_llong)                             :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
        end subroutine nc_diag_realloc_rsingle
        
        ! nc_diag_realloc_rdouble(arr, addl_num_entries)
        !   input:
        !     real(r_double), dimension(:)   :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_rdouble(arr, addl_num_entries)
            real(r_double), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            real(r_double), dimension(:), allocatable    :: tmp
            integer(i_llong)                             :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
        end subroutine nc_diag_realloc_rdouble
        
        ! nc_diag_realloc_string(arr, addl_num_entries)
        !   input:
        !     character(len=*), dimension(:) :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_string(arr, addl_num_entries)
            character(len=*), dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            character(len=len(arr(1))), dimension(:), allocatable   :: tmp
            integer(i_llong)            :: new_size
            
            integer(i_byte)                              :: alloc_err
            character(len=100)                           :: err_msg
            
#ifdef _DEBUG_MEM_
            integer :: string_len, string_arr_size
            
            string_len = len(arr(1))
            string_arr_size = size(arr)
            
            call nclayer_debug("[string] Length of string to allocate to:")
            print *, string_len
            
            call nclayer_debug("[string] Allocating from...")
            print *, string_arr_size
            
            call nclayer_debug("[string] ...to size...")
            print *, (string_arr_size + addl_num_entries)
#endif
            
            new_size = size(arr) + addl_num_entries
            
            allocate(tmp(new_size), stat=alloc_err)
            if (alloc_err /= 0) then
                write(err_msg, "(A, I0)") "Reallocator was unable to reallocate memory! Error code: ", alloc_err
                call nclayer_error(trim(err_msg))
            end if
            tmp(1:size(arr)) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
        end subroutine nc_diag_realloc_string
        
        ! nc_diag_realloc_logical(arr, addl_num_entries)
        !   input:
        !     logical, dimension(:)          :: arr
        !         array to reallocate
        !     integer(i_long), intent(in)    :: addl_num_entries
        !         additional number of elements to allocate to the
        !         specified array
        subroutine nc_diag_realloc_logical(arr, addl_num_entries)
            logical, dimension(:), allocatable, intent(inout) :: arr
            integer(i_llong),intent(in) :: addl_num_entries
            
            logical, dimension(:), allocatable   :: tmp
            integer(i_llong)                     :: new_size
            
            integer(i_llong) :: logical_arr_size
            logical_arr_size = size(arr)
            
            new_size = logical_arr_size + addl_num_entries
            
#ifdef _DEBUG_MEM_
            call nclayer_debug("[logical] Allocating from...")
            print *, logical_arr_size
            
            call nclayer_debug("[logical] ...to size...")
            print *, (logical_arr_size + addl_num_entries)
#endif
            
            allocate(tmp(new_size))
            tmp(1:logical_arr_size) = arr
            deallocate(arr)
            allocate(arr(new_size))
            arr = tmp
#ifdef _DEBUG_MEM_
            call nclayer_debug("[logical] Final size:")
            print *, size(arr)
#endif
        end subroutine nc_diag_realloc_logical
end module ncdw_realloc