get_env Function

public function get_env(NAME, DEFAULT) result(VALUE)

get named environment variable value. It it is blank or not set return the optional default value !print , NAME, ” is not defined in the environment. Strange…” !print , “This processor doesn’t support environment variables. Boooh!”

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: NAME

name of environment variable to get the value of
character(len=*), intent(in), optional :: DEFAULT

default value to return if the requested value is undefined or blank

Return Value character(len=:), allocatable

the returned value


Source Code

    function get_env(NAME,DEFAULT) result(VALUE)
    implicit none
    !> name of environment variable to get the value of
    character(len=*),intent(in)          :: NAME
    !> default value to return if the requested value is undefined or blank
    character(len=*),intent(in),optional :: DEFAULT
    !> the returned value
    character(len=:),allocatable         :: VALUE
    integer                              :: howbig
    integer                              :: stat
    integer                              :: length
        ! get length required to hold value
        length=0
        if(NAME/='')then
           call get_environment_variable(NAME, length=howbig,status=stat,trim_name=.true.)
           select case (stat)
           case (1)
               !*!print *, NAME, " is not defined in the environment. Strange..."
               VALUE=''
           case (2)
               !*!print *, "This processor doesn't support environment variables. Boooh!"
               VALUE=''
           case default
               ! make string to hold value of sufficient size
               allocate(character(len=max(howbig,1)) :: VALUE)
               ! get value
               call get_environment_variable(NAME,VALUE,status=stat,trim_name=.true.)
               if(stat/=0)VALUE=''
           end select
        else
           VALUE=''
        endif
        if(VALUE==''.and.present(DEFAULT))VALUE=DEFAULT
     end function get_env