system_getcwd Subroutine

public subroutine system_getcwd(output, ierr)

NAME

   system_getcwd(3f) - [M_system:QUERY_FILE] call getcwd(3c) to get
                       the pathname of the current working directory
   (LICENSE:PD)

SYNOPSIS

   subroutine system_getcwd(output,ierr)

    character(len=:),allocatable,intent(out) :: output
    integer,intent(out)                      :: ierr

DESCRIPTION

    system_getcwd(3f) calls the C routine getcwd(3c) to obtain the
    absolute pathname of the current working directory.

RETURN VALUE

    OUTPUT   The absolute pathname of the current working directory
             The pathname shall contain no components that are dot
             or dot-dot, or are symbolic links.
    IERR     is not zero if an error occurs.

EXAMPLE

Sample program:

  program demo_system_getcwd
  use M_system, only : system_getcwd
  implicit none
  character(len=:),allocatable :: dirname
  integer                      :: ierr
  call system_getcwd(dirname,ierr)
  if(ierr.eq.0)then
     write(*,*)'CURRENT DIRECTORY ',trim(dirname)
  else
     write(*,*)'ERROR OBTAINING CURRENT DIRECTORY NAME'
  endif
  end program demo_system_getcwd

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=:), intent(out), allocatable :: output
integer, intent(out) :: ierr

Contents

Source Code

system_getcwd

Source Code

subroutine system_getcwd(output,ierr)

! ident_18="@(#) M_system system_getcwd(3f) call getcwd(3c) to get pathname of current working directory"

character(len=:),allocatable,intent(out) :: output
integer,intent(out)                      :: ierr
integer(kind=c_long),parameter           :: length=4097_c_long
character(kind=c_char,len=1)             :: buffer(length)
type(c_ptr)                              :: buffer2
interface
   function c_getcwd(buffer,size) bind(c,name="getcwd") result(buffer_result)
      import c_char, c_size_t, c_ptr
      character(kind=c_char) ,intent(out) :: buffer(*)
      integer(c_size_t),value,intent(in)  :: size
      type(c_ptr)                         :: buffer_result
   end function
end interface
!-----------------------------------------------------------------------------------------------------------------------------------
   buffer=' '
   buffer2=c_getcwd(buffer,length)
   if(.not.c_associated(buffer2))then
      output=''
      ierr=-1
   else
      output=trim(arr2str(buffer))
      ierr=0
   endif
end subroutine system_getcwd