basename Function

public function basename(path, suffix) result(base)

Extract filename from path with/without suffix

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: path
logical, intent(in), optional :: suffix

Return Value character(len=:), allocatable


Source Code

function basename(path,suffix) result (base)

    character(*), intent(In) :: path
    logical, intent(in), optional :: suffix
    character(:), allocatable :: base

    character(:), allocatable :: file_parts(:)
    logical :: with_suffix

    if (.not.present(suffix)) then
        with_suffix = .true.
    else
        with_suffix = suffix
    end if

    call split(path,file_parts,delimiters='\/')
    if(size(file_parts)>0)then
       base = trim(file_parts(size(file_parts)))
    else
       base = ''
    endif
    if(.not.with_suffix)then
        call split(base,file_parts,delimiters='.')
        if(size(file_parts)>=2)then
           base = trim(file_parts(size(file_parts)-1))
        endif
    endif

end function basename