写语句不能在派生类型的用户定义格式化 I/O 过程中生成新行

Posted 2023-03-31

【中文标题】写语句不能在派生类型的用户定义格式化 I/O 过程中生成新行

【英文标题】：Write statement cannot produce new lines within user-defined formatted I/O procedures for derived type

【发布时间】：2018-06-07 06:18:40

【问题描述】：

我想在我的 Fortran 代码中为派生类型实现用户定义的 I/O 过程。但是，这些过程中的write 语句不能在两个连续的write 语句之间产生新行。派生类型和过程定义如下。

模块：

module station_module
    implicit none

    character(8), parameter :: FmtFloat = '(5E15.7)'

    type :: station
        integer, private :: ns = 0
        real, public, allocatable :: xloc(:), yloc(:), zloc(:)
    contains
        procedure, public :: import_station
        procedure, public :: export_station
        procedure, private :: read_station
        generic, public :: read (formatted) => read_station
        procedure, private :: write_station
        generic, public :: write (formatted) => write_station
        final :: destruct_station
    end type station

    interface station
        module procedure new_station
    end interface station

contains

    function new_station(n) result(t)
        implicit none
        integer, intent(in) :: n
        type(station) :: t

        if (n > 0) then
            allocate (t%zloc(n))
            allocate (t%yloc(n))
            allocate (t%xloc(n))
            t%ns = n
        end if
    end function new_station

    subroutine read_station(dtv, unit, iotype, vlist, iostat, iomsg)
        implicit none
        class(station), intent(inout) :: dtv
        integer, intent(in) :: unit
        character(*), intent(in) :: iotype
        integer, intent(in) :: vlist(:)
        integer, intent(out) :: iostat
        character(*), intent(inout) :: iomsg

        call dtv%import_station(unit)

        iostat = 0
    end subroutine read_station

    subroutine import_station(this, unit)
        implicit none
        class(station), intent(inout) :: this
        integer, intent(in) :: unit
        character(256) :: header, footer
        integer ns

        read (unit, '(A)') header !> Header
        read (unit, *) ns
        if (ns > 0) then
            if (allocated(this%zloc)) then
                deallocate (this%zloc)
            end if
            allocate (this%zloc(ns))
            read (unit, *) this%zloc

            if (allocated(this%yloc)) then
                deallocate (this%yloc)
            end if
            allocate (this%yloc(ns))
            read (unit, *) this%yloc

            if (allocated(this%xloc)) then
                deallocate (this%xloc)
            end if
            allocate (this%xloc(ns))
            read (unit, *) this%xloc

            this%ns = ns
        end if
        read (unit, '(A)') footer !> Footer
    end subroutine import_station

    subroutine export_station(this, unit)
        implicit none
        class(station), intent(in) :: this
        integer, intent(in) :: unit

        write (unit, '(A)') ">STATION INFO"
        write (unit, '(I6)') this%ns
        write (unit, *) "Z:"
        write (unit, FmtFloat) this%zloc
        write (unit, *) "Y:"
        write (unit, FmtFloat) this%yloc
        write (unit, *) "X:"
        write (unit, FmtFloat) this%xloc
        write (unit, '(A)') ">END STATION"
    end subroutine export_station

    subroutine write_station(dtv, unit, iotype, vlist, iostat, iomsg)
        implicit none
        class(station), intent(in) :: dtv
        integer, intent(in) :: unit
        character(*), intent(in) :: iotype
        integer, intent(in) :: vlist(:)
        integer, intent(out) :: iostat
        character(*), intent(inout) :: iomsg

        call dtv%export_station(unit)

        iostat = 0
    end subroutine write_station

    subroutine destruct_station(this)
        implicit none
        type(station), intent(inout) :: this

        if (allocated(this%xloc)) then
            deallocate (this%xloc)
        end if
        if (allocated(this%yloc)) then
            deallocate (this%yloc)
        end if
        if (allocated(this%zloc)) then
            deallocate (this%zloc)
        end if
        this%ns = 0
    end subroutine destruct_station

end module station_module

我们可以看到，用户定义的格式化写入语句只是调用了一个名为export_station的常规子例程，我希望这两种方式的结果相同。

这是我的测试程序：

program Test
    use station_module
    implicit none
    type(station) :: pt, pt1, pt2

    pt = station(4)

    write(*, *) pt

    call pt%export_station(6)

end program Test

输出：

 >STATION INFO     4Z:  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00
 Y:  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00X:  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00>END STATION
>STATION INFO
     4
 Z:
  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00
 Y:
  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00
 X:
  0.0000000E+00  0.0000000E+00  0.0000000E+00  0.0000000E+00
>END STATION

常规子程序export_station 产生了我所期望的结果。两个write 语句之间会产生新行，而派生类型的write 语句不会。

【参考方案1】：

英特尔论坛上也有人问过这个问题。我在那里回答。“用户定义的派生类型 I/O 都是非高级的（你不能改变它）。如果你想要换行，你必须明确地写出来（例如使用 / 格式。）”

【讨论】：

只是为了让这一点更明确：WRITE(unit,'(a/)') 这样的东西可以解决问题。

【参考方案2】：

这里有两类输出语句：父级和子级。第一种情况的父输出语句是write (*,*) pt。

当这首先是父级时，通过write_station 调用export_station 会导致写入语句有子输出语句。当用户直接调用export_station 时，这些写语句本身就是父输出语句。

子数据传输语句和父数据传输语句之间的一个显着区别是父语句在数据传输之前和之后定位文件。也就是说，当write (unit,*) "Z:"完成时，文件定位在刚刚写入的记录之后，只有当传输语句是父级时。

因此，您会看到新的行：这只是放在书面记录之后。

子数据传输语句，在完成时不定位文件，不会影响新行。

---

我目前无法使用测试机，所以这部分是推测性的。您可以显式编写从new_line('') 返回的换行符，作为子转移语句输出的一部分。由于advance='no' 将在子语句中被忽略，您可以在这两种情况下都使用它，明确控制写入新行的位置，而不是依赖当前存在的拆分记录方法。

【讨论】：

英特尔论坛上也有人问过这个问题。我在那里回答。“用户定义的派生类型 I/O 都是非高级的（你不能改变它）。如果你想要换行，你必须明确地写出来（例如使用 / 格式。）”

一个更简洁的陈述，@stevelionel 可能更值得作为一个答案而不是评论。

你的答案是正确的，所以我不想踩到你的脚趾，但如果你没问题的话......完成！

仅仅因为我是对的并不意味着我解释得很好;)。但说真的，有多种解释的 Fortran 技术问题太少了。