system_getenv Function

function system_getenv(name, default) result(value)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: name
character(len=*), intent(in), optional :: default

Return Value character(len=:), allocatable


Variables

Type Visibility Attributes Name Initial
integer, public :: howbig
integer, public :: stat

Source Code

function system_getenv(name,default) result(value)

!$@(#) M_system::system_getenv(3f): call get_environment_variable as a function with a default value(3f)

character(len=*),intent(in)          :: name
character(len=*),intent(in),optional :: default
integer                              :: howbig
integer                              :: stat
character(len=:),allocatable         :: value

   if(NAME.ne.'')then
      call get_environment_variable(name, length=howbig, status=stat, trim_name=.true.)  ! get length required to hold value
      if(howbig.ne.0)then
         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 and get value
            if(allocated(value))deallocate(value)
            allocate(character(len=max(howbig,1)) :: VALUE)
            call get_environment_variable(name,value,status=stat,trim_name=.true.)
            if(stat.ne.0)VALUE=''
         end select
      else
         value=''
      endif
   else
      value=''
   endif
   if(value.eq.''.and.present(default))value=default

end function system_getenv