TNO Intern

Commit b86cbfe7 authored by Arjo Segers's avatar Arjo Segers
Browse files

Added `CSO_GetBasename` and `CSO_SplitExt` routines.

parent eb8476fc

oper/src/cso_file.F90

+104 −6
Original line number Diff line number Diff line
@@ -2,7 +2,7 @@ 
!

! File tools.

!

! HISTORY

! CHANGES

!

! 2022-09, Arjo Segers

!   Added `CSO_CheckDir` routine.
@@ -10,6 +10,9 @@ 
! 2023-01, Arjo Segers

!   Fixed problem with creation of output directories when using Intel compiler.

!

! 2026-07, Arjo Segers

!   Added `CSO_GetBasename` and `CSO_SplitExt` routines.

!

!#################################################################

!

#define TRACEBACK write (csol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call csoErr
@@ -32,6 +35,8 @@ module CSO_File 


  public  ::  CSO_GetFU

  public  ::  CSO_GetDirname

  public  ::  CSO_GetBasename

  public  ::  CSO_SplitExt

  public  ::  CSO_CheckDir

  public  ::  T_CSO_TextFile
@@ -157,7 +162,7 @@ contains 


    ! --- const ---------------------------



    character(len=*), parameter  ::  rname = mname//'/CSO_GetFU'

    character(len=*), parameter  ::  rname = mname//'/CSO_GetDirname'



    ! --- local --------------------------
@@ -180,6 +185,99 @@ contains 
    status = 0



  end subroutine CSO_GetDirname

  ! *





  ! return filename part of path



  subroutine CSO_GetBasename( filename, basename, status )



    ! --- in/out --------------------------



    character(len=*), intent(in)    ::  filename

    character(len=*), intent(out)   ::  basename

    integer, intent(out)            ::  status



    ! --- const ---------------------------



    character(len=*), parameter  ::  rname = mname//'/CSO_GetBasename'



    ! --- local --------------------------



    integer               ::  n

    integer               ::  i



    ! --- local ---------------------------



    ! size:

    n = len_trim(filename)

    ! search backward for path sep:

    i = index( filename, '/', back=.true. )

    ! found?

    if ( i > 0 ) then

      ! part from seperator onwards:

      if ( i < n ) then

        basename = filename(i+1:n)

      else

        basename = ''

      end if

    else

      ! no path ...

      basename = trim(filename)

    end if



    ! ok

    status = 0



  end subroutine CSO_GetBasename





  ! *





  ! split filename in basename and extension



  subroutine CSO_SplitExt( filename, rootname, ext, status )



    ! --- in/out --------------------------



    character(len=*), intent(in)    ::  filename

    character(len=*), intent(out)   ::  rootname

    character(len=*), intent(out)   ::  ext

    integer, intent(out)            ::  status



    ! --- const ---------------------------



    character(len=*), parameter  ::  rname = mname//'/CSO_SplitExt'



    ! --- local --------------------------



    integer               ::  n

    integer               ::  i



    ! --- local ---------------------------



    ! size:

    n = len_trim(filename)

    ! search backward for dot:

    i = index( filename, '.', back=.true. )

    ! found?

    if ( i > 0 ) then

      ext = filename(i:n)

      if ( i > 1 ) then

        rootname = filename(1:i-1)

      else

        rootname = ''

      end if

    else

      rootname = trim(filename)

      ext = ''

    end if



    ! ok

    status = 0



  end subroutine CSO_SplitExt



  ! *