C.2.1 Basename_Shell_Utils Procedure

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

  function Basename_Shell_Utils (Filename, Suffix_Strip) result(Basename)

    ! Input variables.

    type(character,*), intent(in) :: Filename           ! Filename.
    type(logical), intent(in), optional :: Suffix_Strip ! Suffix strip toggle.

    ! Output variables.

    type(character,255) :: Basename ! The basename of the filename.

    ! Internal variables.

    integer :: basename_left        ! Left extent of the basename.
    integer :: basename_right       ! Right extent of the basename.
    logical :: A_Suffix_Strip       ! Actual suffix strip toggle.

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

    ! Verify requirements.

    VERIFY(Valid_State(Filename),5)          ! Filename is valid.
    VERIFY(LEN_TRIM(Filename) /= 0,5)        ! Filename is non-null.

    ! Set suffix strip toggle.
    
    if (PRESENT(Suffix_Strip)) then
      A_Suffix_Strip = Suffix_Strip
    else
      A_Suffix_Strip = .true.
    end if

    ! Determine first character in basename.

    basename_left = MAX(1, INDEX(Filename, '/', .true.) + 1)

    ! Determine final character in basename.

    if (A_Suffix_Strip) then
      basename_right = INDEX(Filename, '.', .true.) - 1
      if (basename_right == -1 .or. basename_right < basename_left) then
        basename_right = LEN_TRIM(Filename)
      end if
    else
      basename_right = LEN_TRIM(Filename)
    end if

    ! Set basename.

    Basename = Filename(basename_left:basename_right)

    ! Verify guarantees.

    VERIFY(Valid_State(Basename),5)  ! Basename is valid.

    return
  end function Basename_Shell_Utils