Write statement cannot produce new lines within user-defined formatted I/O procedures for derived type in FORTRAN

Libin · ‎12-26-2017

I want to implement the user-defined I/O procedures for the derived types in my FORTRAN code. However, write statements within those procedures cannot produce new lines between two sequential write statements. The derived type is defined in FORTRAN module file as below,

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

We can see that the user-defined formatted write statement just call a regular subroutine named export_station, by which I expect the same result in both ways.

Here is my test program:

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

The output:

 >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

The regular subroutine export_station produces what I expect. New lines are produced between two write statements, while write statement of the derived type does not.

Is it a bug or do I miss something?

Best,
Libin

Steve_Lionel · ‎12-26-2017

User-defined derived-type I/O is all non-advancing (and you can't change this). If you want newlines you have to write them explicitly (using a / format, for example.)