Issues with User-Defined Derived-Type I/O

The question is pretty long so I would really appreciate it if you can read it through. Let’s say I have two modules module_a and module_b, each containing a derived type a_type and b_type. Also, I used the User-Defined Derived-Type I/O (UDDTIO) for each type, so there exists a write(formatted) for each module. The minimal code that generates error is shown below (io.f90),

module module_a

  implicit none
  public :: a_type
  public :: write(formatted)
  private

  type :: a_type
    integer :: value
  end type a_type

  interface write(formatted)
    module procedure :: write_formatted_a
  end interface write(formatted)

contains

  subroutine write_formatted_a(self, unit, iotype, v_list, iostat, iomsg)
    class(a_type), intent(in) :: self
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list (:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    if (iotype == 'DT') then
      write (unit, fmt="(i0)", iostat=iostat, iomsg=iomsg) self%value
    end if
  end subroutine write_formatted_a

end module module_a

module module_b

  implicit none
  public :: b_type
  public :: write(formatted)
  private

  type :: b_type
    integer :: value
  end type b_type

  interface write(formatted)
    module procedure :: write_formatted_b
  end interface write(formatted)

contains

  subroutine write_formatted_b(self, unit, iotype, v_list, iostat, iomsg)
    class(b_type), intent(in) :: self
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list (:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    if (iotype == 'DT') then
      write (unit, fmt="(i0)", iostat=iostat, iomsg=iomsg) self%value
    end if
  end subroutine write_formatted_b

end module module_b

program main

  use module_a
  use module_b
  implicit none

  type(a_type) :: a = a_type(1)
  type(b_type) :: b = b_type(2)

  print "(a, dt)", "A = ", a
  print "(a, dt)", "B = ", b

end program main

gfortran compiles and runs the code with no complains

> gfortran io.f90
> ./a.out
A = 1
B = 2

but intel compiler tells me

> ifx io.f90
io.f90: error #8638: The type/rank signature for arguments 
of this specific subroutine is identical to another specific subroutine 
that shares the same defined I/O.   [MODULE_A^WRITE_FORMATTED_A]
io.f90: error #8638: The type/rank signature for arguments 
of this specific subroutine is identical to another specific subroutine 
that shares the same defined I/O.   [MODULE_B^WRITE_FORMATTED_B]
compilation aborted for io.f90 (code 1)
  • The first question is: Is this complain standard-compliant? write_formatted_a clearly has a different argument with write_formatted_b.

There are a few workarounds. For example, I could use a type-bound procedure and generic binding on one or both of the derived-types.

type :: a_type
  integer :: value
contains
  procedure :: write_formatted_a
  generic :: write(formatted) => write_formatted_a
end type a_type

Or, if I don’t want to use the “type-bound procedure style”, I could write another module and put all “write_foramtted” procedures under the same write(formatted)

interface write(formatted)
  module procedure :: write_formatted_a
  module procedure :: write_formatted_b
end interface write(formatted)

But, if I am using external modules, say string_type from stdlib. (1) It’s probably a very bad idea to refactor the whole stdlib_string_type to the “type-bound procedure style”, and (2) it’s also impossible to put all “write_formatted” procedures under the same interface write(formatted) because the procedure write_formatted of the string_type is private. The only workaround left is to refactor my own code into the “type-bound procedure style”, which is also a lot of work…so

  • The second question is: Is there an elegant solution that would allow my code to be compatible with both compilers?
1 Like

No, this is a compiler bug with Intel Fortran. You can open a thread at the Intel Fortran forum and hope the Intel staff picks it up, or if you have support subscription, you can submit a request at their support center.

1 Like

Since the underlying issue is a bug in one of the compilers, nothing is going to be elegant.

You have identified your options, now it is unfortunately a matter of “pick your poison.”

Hey @FortranFan thanks! I just created an account and opened a thread at the Intel forum. Issues with User-Defined Derived-Type I/O - Intel Community. For now, I guess I will have to refactor my own code…