Fortran 2003-2008中是否有GETCWD()的替代方法？

Question

GNU Fortran编译器的GNU扩展提供了子例程GETCWD()，它可以获得当前工作目录。但是，我的代码也要在ifort和nagfor编译器上可移植，并且我使用F2003特性。

那么，是否有F2003及更高版本的GETCWD()替代方法呢？

我这里有标准文件，但它非常庞大，而且我已经花了一段时间浏览它，但没有找到任何有用的内容...

- LienM

Answer 1

如评论中所述，您可以使用标准Fortran的get_environment_variable（例如F2008 13.7.67）。此示例程序查询$PWD的值，该变量应该包含您调用可执行文件时Shell所在的目录。

program test
 implicit none
 character(len=128) :: pwd
 call get_environment_variable('PWD',pwd)
 print *, "The current working directory is: ",trim(pwd)
end program

输出结果如下：

casey@convect code % pwd
/home/casey/code
casey@convect code % so/getpwd 
 The current working directory is: /home/casey/code

这是标准的Fortran代码，但其可移植性将受限于设置此变量的Unix和类Unix shell。

另一种选择是使用标准但不太美观（在我看来）的execute_command_line命令来运行一个能够将当前工作目录输出到临时文件的命令（例如pwd > /tmp/mypwd），然后读取该文件。

- casey

---

"PWD" 在 Windows 系统中不可用，您需要查询 "CD"。 - Alexander Vogt

谢谢你，Casey！:) 因为在这种情况下可移植性确实是个问题，所以我接受了Alexander的答案，但你的答案肯定会对我和其他人在未来有用。 - LienM

@AlexanderVogt 我尝试将PWD更改为CD: call get_environment_variable('CD',currDir)。但这在Windows上无法工作（我已尝试使用gfortran和ifort）。 你有什么建议吗？ - Bayraktaroglu

Answer 2

你也可以使用 ISO_C_Binding 并调用相应的 C 函数：

cwd.c:

#ifdef _WIN32
/* Windows */
#include <direct.h>
#define GETCWD _getcwd

#else
/* Unix */
#include <unistd.h>
#define GETCWD getcwd

#endif

void getCurrentWorkDir( char *str, int *stat )
{
  if ( GETCWD(str, sizeof(str)) == str ) {
    *stat = 0;
  } else {
    *stat = 1;
  }
}

test.F90:

program test
 use ISO_C_Binding, only: C_CHAR, C_INT
 interface
   subroutine getCurrentWorkDir(str, stat) bind(C, name="getCurrentWorkDir")
     use ISO_C_Binding, only: C_CHAR, C_INT
     character(kind=C_CHAR),intent(out) :: str(*)
     integer(C_INT),intent(out)         :: stat
    end subroutine
  end interface
  character(len=30)   :: str
  integer(C_INT)      :: stat

  str=''
  call getCurrentWorkDir(str, stat)
  print *, stat, trim(str)

end program

这段代码适用于Windows和Unix衍生系统（Linux、OSX、BSD等）。

- Alexander Vogt

---

谢谢您的详细回答！ :) 我在与C进行接口方面缺乏经验，但我会尝试。如果我说这会导致我的makefile变得稍微复杂一些，因为我需要为C定义一个编译器，那么我的理解是正确的吗？ - LienM

这要看情况...编译这个例子，我只是使用了 gfortran -Wall -Wextra -g cwd.c test.F90。 - Alexander Vogt

Answer 3

接受的答案包含两个错误（将错误的字符串长度值传递给GETCWD，并留下了C_NULL_CHAR）。这个答案纠正了这些错误，并使接口在Fortran中更易用。

基本思想是相同的：使用C调用getcwd或_getcwd，并使用Fortran的C互操作特性调用C包装器。在Fortran方面，一个包装子程序被用来处理字符串长度，因此不必显式地传递它。

此外，C_INT和C_CHAR不一定与默认整数和默认字符相同，在Fortran方面需要它们（虽然在实践中我不知道任何C_CHAR和默认字符不同的系统）。包装器也会进行转换。从C返回的字符串包含终止的C_NULL_CHAR，必须将其删除才能在Fortran方面使用该字符串。

C代码：

#ifdef _WIN32
#include <direct.h>
#define GETCWD _getcwd
#else
#include <unistd.h>
#define GETCWD getcwd
#endif

/* Return 0 on success, 1 on error. */
int getCWDHelper(char *str, int len)
{
    return GETCWD(str, len) != str;
}

Fortran代码：

module cwd
    use iso_c_binding, only: C_INT, C_CHAR, C_NULL_CHAR
    implicit none
    private
    public :: getCWD

    interface
        function getCWDHelper(str, len) bind(C, name="getCWDHelper")
            use iso_c_binding, only: C_INT, C_CHAR
            integer(kind=C_INT) :: getCWDHelper
            character(kind=C_CHAR), intent(out) :: str(*)
            integer(kind=C_INT), value :: len
        end function getCWDHelper
    end interface

contains

    ! Writes the current working directory path into str.
    ! Returns 0 on success, or 1 on error.
    function getCWD(str)
        integer :: getCWD
        character(*), intent(out) :: str

        integer :: i, length
        character(len=len(str), kind=C_CHAR) :: str_copy

        ! Call the C helper, passing the length as the correct int kind
        getCWD = getCWDHelper(str_copy, len(str_copy, kind=C_INT))

        if (getCWD /= 0) then
            str = '' ! Error, clear the string
            return
        end if

        ! Copy the C_CHAR string to the output string,
        ! removing the C_NULL_CHAR and clearing the rest.
        length = index(str_copy, C_NULL_CHAR) - 1
        do i = 1, length
            str(i:i) = char(ichar(str_copy(i:i)))
        end do
        str(length+1:) = ''
    end function getCWD

end module

测试代码：

program test
    use cwd, only: getCWD
    implicit none

    character(len=255) :: path
    integer :: error

    error = getCWD(path)

    print *, error
    if (error == 0) print *, path
end program

将返回值分配为可分配的并循环以获得足够的大小留给读者自行练习。最初的回答。

- rtoijala