C.2.2 Dirname_Shell_Utils Procedure

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

  function Dirname_Shell_Utils (Filename) result(Dirname)

    ! Input variables.

    type(character,*), intent(in) :: Filename           ! Filename.

    ! Output variables.

    type(character,255) :: Dirname ! The dirname of the filename.

    ! Internal variables.

    integer :: dirname_right       ! Right extent of the dirname.

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

    ! Verify requirements.

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

    ! Determine final character in dirname.

    dirname_right = INDEX(Filename, '/', .true.) - 1

    ! Set dirname.

    select case (dirname_right)
    case (0)
      Dirname = '/'
    case (-1)
      Dirname = '.'
    case default
      Dirname = Filename(1:dirname_right)
    end select

    ! Verify guarantees.

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

    return
  end function Dirname_Shell_Utils