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 and procedures are defined as below.
The module:
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.
This was also asked on the Intel forum. I replied there."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.)"
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With