ncdw_strarrutils.F90

Go to the documentation of this file.

! utils.f90
! general utilities for Fortran programs
! Author: Albert Huang for SSAI/NASA GSFC GMAO

module ncdw_strarrutils
    implicit none
    
    contains
        function lentrim(s)
            character(len=*) :: s
            integer lentrim

            do lentrim = len(s), 1, -1
              if (s(lentrim:lentrim) .ne. ' ') return
            end do
        end function lentrim
        
        function string_count_substr(s, substr) result(sub_count)
            character(len=*), intent(in)      :: s
            character(len=*), intent(in)      :: substr
            integer                           :: sub_count
            
            integer                           :: substr_len, i, jump
            substr_len = len(substr)
            sub_count = 0
            jump = 1
            i = 1
            
            do while (i <= len(s) - len(substr))
                if (s(i:i+len(substr)-1) == substr) then
                    sub_count = sub_count + 1
                    jump = len(substr)
                else
                    jump = 1
                end if
                
                i = i + jump
            end do
        end function string_count_substr
        
        function string_get_max_split(s, substr) result(max_len)
            character(len=*), intent(in)      :: s
            character(len=*), intent(in)      :: substr
            integer                           :: sub_count
            
            integer                           :: substr_len, i, jump
            integer                           :: max_len, tmp_len
            
            substr_len = len(substr)
            sub_count = 0
            jump = 1
            i = 1
            
            tmp_len = 0
            max_len = 0
            
            do while (i <= len_trim(s) - len(substr) + 1)
                if (s(i:i+len(substr)-1) == substr) then
                    sub_count = sub_count + 1
                    if (tmp_len > max_len) max_len = tmp_len
                    tmp_len = 0
                    jump = len(substr)
                else
                    jump = 1
                    tmp_len = tmp_len + 1
                end if
                
                i = i + jump
            end do
            
            ! Do one more check to ensure we get the end!
            if ((tmp_len + len(substr) - 1) > max_len) max_len = tmp_len + len(substr) - 1
        end function string_get_max_split
        
        function string_split_index(s, delimiter) result(split_strings)
            character(len=*)      :: s
            character(len=*)      :: delimiter
            
            integer                           :: substr_len, i, jump
            integer                           :: tmp_idx, start_idx, total
            integer                           :: split_length, item_length
            
            character(len=:), allocatable     :: split_strings(:)
            character(len=:), allocatable     :: tmp_str
            
            ! Get lengths
            split_length = string_count_substr(s, delimiter) + 1
            item_length = string_get_max_split(s, delimiter)
            
            allocate(character(item_length) :: split_strings(split_length))
            allocate(character(item_length) :: tmp_str)
            
            substr_len = len(delimiter)
            jump = 1
            i = 1
            
            tmp_idx = 1
            start_idx = 1
            total = 1
            
            do while (i <= len_trim(s) - len(delimiter) + 1)
                if (s(i:i+len(delimiter)-1) == delimiter) then
                    if (start_idx /= tmp_idx) then
                        split_strings(total) = s(start_idx:tmp_idx - 1)
                    else
                        split_strings(total) = ""
                    end if
                    
                    tmp_idx = tmp_idx + len(delimiter)
                    start_idx = tmp_idx
                    
                    total = total + 1
                    
                    jump = len(delimiter)
                else
                    jump = 1
                    tmp_idx = tmp_idx + 1
                end if
                
                i = i + jump
            end do
            
            ! Do one more check to ensure we get the end!
            split_strings(total) = s(start_idx:tmp_idx - 1)
        end function string_split_index
        
        ! asl = assumed shape length
        subroutine string_array_dump(strings)
            character(len=:), allocatable     :: strings(:)
            integer i
            
            write (*, "(A, I0)") "Length of strings array: ", size(strings(:))
            print *, " -> String array dump:"
            
            do i = 1, size(strings(:))
                if (strings(i) == "") then
                    write (*, "(A, I0, A, I0, A, I0, A)") "  --> Position ", i, ": (empty) [Trim length = ", len_trim(strings(i)), ", Full length = ", len(strings(i)), "]"
                else
                    write (*, "(A, I0, A, A, A, I0, A, I0, A)") "  --> Position ", i, ": '", trim(strings(i)), "' [Trim length = ", len_trim(strings(i)), ", Full length = ", len(strings(i)), "]"
                end if
            end do
        end subroutine string_array_dump
        
        function max_len_string_array(str_arr, arr_length) result(max_len)
            character(len=*), intent(in) :: str_arr(:)
            integer         , intent(in) :: arr_length
            
            integer :: i, max_len
            
            max_len = -1
            
#ifdef _DEBUG_MEM_
            write (*, "(A, I0)") " ** max_len_string_array: size(str_arr) is ", size(str_arr)
#endif
            
            do i = 1, arr_length
                if (len_trim(str_arr(i)) > max_len) max_len = len_trim(str_arr(i))
#ifdef _DEBUG_MEM_
                write (*, "(A, I0, A, I0)") "max_len_string_array: str_arr(", i, ") is " // trim(str_arr(i)) // ", size is ", len_trim(str_arr(i))
                write (*, "(A, I0)") "max_len_string_array: max_len is ", max_len
#endif
            end do
        end function max_len_string_array
        
        function max_len_notrim_string_array(str_arr, arr_length) result(max_len)
            character(len=*), intent(in) :: str_arr(:)
            integer         , intent(in) :: arr_length
            
            integer :: i, max_len
            
            max_len = -1
            
#ifdef _DEBUG_MEM_
            write (*, "(A, I0)") " ** max_len_notrim_string_array: size(str_arr) is ", size(str_arr)
#endif
            
            do i = 1, arr_length
                if (len(str_arr(i)) > max_len) max_len = len(str_arr(i))
#ifdef _DEBUG_MEM_
                write (*, "(A, I0, A, I0)") "max_len_notrim_string_array: str_arr(", i, ") is " // trim(str_arr(i)) // ", size is ", len_trim(str_arr(i))
                write (*, "(A, I0)") "max_len_notrim_string_array: max_len is ", max_len
#endif
            end do
        end function max_len_notrim_string_array
        
        subroutine string_before_delimiter(s, delimiter, string_part)
            character(len=*), intent(in)      :: s
            character(len=*), intent(in)      :: delimiter
            character(len=:), intent(inout), allocatable :: string_part
            
            integer                             :: substr_len, i, jump
            integer                             :: tmp_idx, start_idx, total
            
            logical found
            found = .false.
            
            ! Get lengths
            substr_len = len(delimiter)
            jump = 1
            i = 1
            
            tmp_idx = 1
            start_idx = 1
            total = 1
            
            do while (i <= len_trim(s) - len(delimiter) + 1)
                if (s(i:i+len(delimiter)-1) == delimiter) then
                    found = .true.
                    exit
                else
                    jump = 1
                    tmp_idx = tmp_idx + 1
                end if
                
                i = i + jump
            end do
            
            ! Do one more check to ensure we get the end!
            if (found) then
                if (start_idx == tmp_idx) then
                    allocate(character(0) :: string_part)
                    string_part = ""
                else
                    allocate(character(tmp_idx - start_idx + 1) :: string_part)
                    string_part = s(start_idx:tmp_idx - 1)
                end if
            else
                allocate(character(len(s)) :: string_part)
                string_part = s
            end if
        end subroutine string_before_delimiter
end module ncdw_strarrutils