如何包装Fortran的写入语句(write-statement)

Question

我希望将Fortran中的write-statement包装在一个自定义子程序或函数中，其中包括一些额外的调试逻辑。

但我目前卡在定义函数/子程序的原型上。这是可能的吗？如果是，如何做到？

- Joachim Rosskopf

---

你是否试图在不修改write语句语法的情况下通过包装它在自己的函数调用中来修改其行为？简短的回答是你不能这样做。也许一些预处理器技巧可以帮助你实现，但我认为这会很混乱。 - agentp

啊，那听起来不太好。我只是想在写入前放置一个短路（如果（flag .neqv. .true.）则返回结束），以全局控制是否发生输出。除此之外，该函数应该简单地委托给写入。 - Joachim Rosskopf

Answer 1

您的问题标题存在一些误解，但是从文本中可以看出您对此有所了解。不过，为了记录，write是一条Fortran语句，既不是子例程也不是函数。

我认为您有几个选项。其中一个是我偶尔使用的，那就是编写一个返回字符串的函数。或许：

function error_message(error)
    character(len=*), intent(in) :: error
    character(len=:), allocatable :: error_message
    error_message = 'ERROR: '//trim(error)
end function error_message

您可以像这样使用它

write(*,*) error_message('Oh s**t')

你当然可以编写一个具有副作用的子程序或函数，其中包括写入输出通道，但如果你采用这种方法，必须小心遵守递归I/O的规则。

编辑：

根据OP的评论。

如果你想关闭调试消息，另一个选择是将它们定向到空设备或文件，例如Linux上的/dev/null或Windows上的NUL。类似这样的东西。

integer, parameter :: debug_channel = 99
logical, parameter :: debugging = .false.
...
if (debugging) then
   open(debug_channel, file='NUL')
else
   open(debug_channel, file='debuglog'
end if

然后。

write(debug_channel,*) 'message'

- High Performance Mark

---

我尝试这样做的原因是，我想要一个版本的写作，在其中可以全局地打开和关闭调试输出。 - Joachim Rosskopf

Answer 2

要实现您想要的大部分内容，比较简单的方法是将if直接放在每个受调试控制的写入语句前面：

    if(debug)write(..,..).. 

其中 debug 是一个全局逻辑值，或者甚至是：

    if(debugf(level))write(..,..).. 

其中逻辑函数 debugf 决定是否基于某些参数进行写入操作。

- agentp

Answer 3

除了其他答案，您也可以使用派生类型IO来避免使用if (debug) write...。

我说“可能”，因为这很愚蠢，除非您已经有一个合适的结构，并且编译器支持目前很少。

然而，例如，使用ifort 14.0.1编译：

module errormod

  type error_t
     character(len=:), allocatable :: message
   contains
     procedure write_error
     generic :: write(formatted) => write_error
  end type error_t

  logical debug_verbose

contains

  subroutine write_error(err, unit, iotype, v_list, iostat, iomsg)
    class(error_t), intent(in)  :: err
    integer, intent(in)  :: unit
    character(len=*), intent(in)  :: iotype
    integer, intent(in), dimension(:)  :: v_list
    integer, intent(out)  :: iostat
    character(len=*), intent(inout)  :: iomsg

    if (debug_verbose) then
       write(unit, '("Error: ", A)', iostat=iostat, iomsg=iomsg) err%message
    else
       write(unit, '()', advance='no')
    end if

  end subroutine write_error

end module errormod


program test

  use errormod

  implicit none

  type(error_t) error

  debug_verbose = .TRUE.
  error%message = "This error will be reported."
  write(*, '(dt)') error

  debug_verbose = .FALSE.
  error%message = "This error will not be reported."
  write(*, '(dt)') error

  debug_verbose = .TRUE.
  error%message = "This final error will also be reported."
  write(*, '(dt)') error

end program test

第一条和第三条信息会出现，但第二条不会。

- francescalus

---

+1。不知道为什么这个还没有被点赞。顺便说一下，作为FORTRAN标签的顶级用户之一，我想你会很高兴看到这个：https://mattermodeling.stackexchange.com/q/6252/5 在一个全新的SE网站上！ - Nike