xrd_unix_env.F90

Go to the documentation of this file.

MODULE xrd_unix_env

!**** *XRD_UNIX_ENV*  - 

!     Author. 
!     ------- 
!      Philippe Marguinaud *METEO FRANCE*
!      Original : 11-09-2012

USE parkind1, ONLY : jpim, jprb, jplm
IMPLICIT NONE

CONTAINS

SUBROUTINE xrd_getenv( KEY, VAL )
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: KEY
  CHARACTER(LEN=*), INTENT(OUT) :: VAL

  CALL get_environment_variable( key, val )
END SUBROUTINE xrd_getenv


FUNCTION xrd_iargc()
  IMPLICIT NONE
  INTEGER(KIND=JPIM) :: XRD_IARGC
  xrd_iargc = command_argument_count()
END FUNCTION xrd_iargc

SUBROUTINE xrd_getarg( KEY, VAL )
  IMPLICIT NONE
  INTEGER(KIND=JPIM), INTENT(IN) :: KEY
  CHARACTER(LEN=*), INTENT(OUT) :: VAL
  CALL getarg( int(key,selected_int_kind(9)), val )
END SUBROUTINE xrd_getarg

SUBROUTINE xrd_exit( STATUS )
  IMPLICIT NONE
  INTEGER(KIND=JPIM), INTENT(IN) :: STATUS
  CALL exit( int(status,selected_int_kind(9)) )
END SUBROUTINE xrd_exit

SUBROUTINE xrd_mkdir( PATH )
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: PATH
  CALL system( "mkdir -p "//trim(path))
END SUBROUTINE xrd_mkdir

CHARACTER*256 FUNCTION xrd_dirname( PATH )
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: PATH

  INTEGER(KIND=JPIM) :: I
  xrd_dirname = ""
  i = len( trim( path ) ) - 1
  DO
    IF( i .LE. 0 ) RETURN
    IF( path(i:i) .EQ. '/' ) EXIT
    i = i - 1
  ENDDO
  xrd_dirname = path(1:i)
END FUNCTION xrd_dirname

FUNCTION xrd_basename( PATH )
  IMPLICIT NONE
  CHARACTER*256 :: XRD_BASENAME
  CHARACTER(LEN=*), INTENT(IN) :: PATH

  INTEGER(KIND=JPIM) :: I
  xrd_basename = ""
  i = len( trim( path ) ) - 1
  DO
    IF( i .LE. 0 ) THEN
      i = 0
      EXIT
    ENDIF
    IF( path(i:i) .EQ. '/' ) EXIT
    i = i - 1
  ENDDO
  xrd_basename = path(i+1:)
END FUNCTION xrd_basename

ELEMENTAL SUBROUTINE xrd_lower_case(OUS,INS)
IMPLICIT NONE
! CONVERT A WORD TO LOWER CASE
CHARACTER (LEN=*) , INTENT(OUT) :: OUS
CHARACTER (LEN=*) , INTENT(IN) :: INS
INTEGER :: I,IC,NLEN
nlen = len(ins)
ous = ''
DO i=1,nlen
   ic = ichar(ins(i:i))
   IF (ic >= 65 .AND. ic < 90) THEN
     ous(i:i) = char(ic+32)
   ELSE
     ous(i:i) = ins(i:i)
   ENDIF
END DO
END SUBROUTINE xrd_lower_case

FUNCTION xrd_isalpha(C)
IMPLICIT NONE
LOGICAL(KIND=JPLM) :: XRD_ISALPHA
CHARACTER, INTENT(IN) :: C

xrd_isalpha = ((c.GE.'A').AND.(c.LE.'Z'))&
            .OR.((c.GE.'a').AND.(c.LE.'z'))

END FUNCTION xrd_isalpha

FUNCTION xrd_isdigit(C)
IMPLICIT NONE
LOGICAL(KIND=JPLM) :: XRD_ISDIGIT
CHARACTER, INTENT(IN) :: C

xrd_isdigit = (c.GE.'0').AND.(c.LE.'9')

END FUNCTION xrd_isdigit

SUBROUTINE xrd_date_and_time( VL )
IMPLICIT NONE
INTEGER(KIND=JPIM), INTENT(OUT) :: VL(8)
!
INTEGER :: VLX(8)

  CALL date_and_time( values = vlx )

  vl = vlx
END SUBROUTINE xrd_date_and_time

SUBROUTINE xrd_cpu_time( T )
  IMPLICIT NONE
  REAL,INTENT(OUT) :: T
  CALL cpu_time( t )
END SUBROUTINE xrd_cpu_time

SUBROUTINE xrd_countlines( NLINES, F, ERR )
IMPLICIT NONE
INTEGER(KIND=JPIM), INTENT(OUT) :: NLINES
CHARACTER*(*), INTENT(IN) :: F
INTEGER(KIND=JPIM), INTENT(OUT) :: ERR
CHARACTER*32 :: STR

nlines = 0
OPEN( 77, file = f, err = 888 )

DO
  READ( 77, *, err = 888, end = 777 ) str
  nlines = nlines + 1
ENDDO

777 CONTINUE

CLOSE( 77 )

RETURN
888 CONTINUE
  err = 1
END SUBROUTINE xrd_countlines

FUNCTION xrd_countwords( S )
  IMPLICIT NONE
  INTEGER(KIND=JPIM) :: XRD_COUNTWORDS
  CHARACTER(LEN=*), INTENT(IN) :: S
  INTEGER(KIND=JPIM) :: N, I, L
  LOGICAL(KIND=JPLM) :: IN
  n = 0_jpim
  in = .false.
  l = len( trim( s ) )
  DO i = 1, l
    IF( s(i:i) .EQ. ' ' ) THEN
      in = .false.
    ELSE IF( .NOT. in ) THEN
      n = n + 1
      in = .true.
    ENDIF
  ENDDO
  xrd_countwords = n
END FUNCTION xrd_countwords

END MODULE xrd_unix_env