Intel® Fortran Compiler 17.0 Developer Guide and Reference

Examples of User-Defined Derived-Type I/O

Example 1

The following example shows formatted defined I/O using the DT edit descriptor and both generic type-bound and explicit interface procedures: 


MODULE TYPES
  TYPE T
     INTEGER :: K(10)
   CONTAINS

! a generic type-bound procedure
     PROCEDURE :: UDIO_READ_ARRAY
     GENERIC :: READ (FORMATTED) => UDIO_READ_ARRAY
  END TYPE T

! an explicit interface
  INTERFACE WRITE(FORMATTED)
     MODULE PROCEDURE UDIO_WRITE_ARRAY
  END INTERFACE
 CONTAINS
  SUBROUTINE UDIO_READ_ARRAY (DTV, UNIT, IOTYPE, V_LIST, IOSTAT, IOMSG)
    CLASS(T), INTENT(INOUT)     :: DTV
    INTEGER, INTENT(IN)         :: UNIT
    CHARACTER(*), INTENT(IN)    :: IOTYPE
    INTEGER, INTENT(IN)         :: V_LIST (:)
    INTEGER, INTENT(OUT)        :: IOSTAT
    CHARACTER(*), INTENT(INOUT) :: IOMSG
 
! This is the child I/O that gets performed when the procedure
! is called from a parent I/O – it uses list-directed input to read
! the array K

    READ (UNIT, FMT=*, IOSTAT=IOSTAT, IOMSG=IOMSG) DTV%K

    END SUBROUTINE UDIO_READ_ARRAY

  SUBROUTINE UDIO_WRITE_ARRAY (DTV, UNIT, IOTYPE, V_LIST, IOSTAT, IOMSG)
  CLASS(T), INTENT(IN)        :: DTV 
  INTEGER, INTENT(IN)         :: UNIT
  CHARACTER(*), INTENT(IN)    :: IOTYPE
  INTEGER, INTENT(IN)         :: V_LIST (:)
  INTEGER, INTENT(OUT)        :: IOSTAT
  CHARACTER(*), INTENT(INOUT) :: IOMSG

! This is the child I/O that gets performed when the procedure
! is called from a parent I/O – it uses list-directed output to write
! the array K

        WRITE (UNIT, FMT=*, IOSTAT=IOSTAT, IOMSG=IOMSG) DTV%K

  END SUBROUTINE UDIO_WRITE_ARRAY

 END MODULE TYPES

 PROGRAM TEST1
  USE TYPES
  TYPE (T) :: V
  INTEGER  :: COUNTCHAR

   OPEN (1, FILE='TEST.INPUT', FORM='FORMATTED')
    READ (1, FMT='(DT)', ADVANCE='NO', SIZE=COUNTCHAR) V
  CLOSE(UNIT=1)
  WRITE(6, '(DT)') V

 END PROGRAM TEST1

Consider that procedure UDIO_READ_ARRAY reads an input file named TEST.INPUT that contains the following: 

1, 3, 5, 7, 9, 2, 4, 6, 8, 10

In this case, the program TEST1 in procedure UDIO_WRITE_ARRAY prints: 

           1           3           5           7           9           2
           4           6           8          10

Example 2

The following example shows list-directed formatted output and user-defined I/O: 


MODULE M
  TYPE T
     REAL, POINTER :: R (:)
   CONTAINS
     PROCEDURE :: UDIO_WRITE_LD
     GENERIC   :: WRITE(FORMATTED) => UDIO_WRITE_LD
  END TYPE T
 
CONTAINS
  SUBROUTINE UDIO_WRITE_LD (DTV, UNIT, IOTYPE, V_LIST, IOSTAT, IOMSG)
    CLASS(T), INTENT(IN)            :: DTV
    INTEGER, INTENT(IN)             :: UNIT
    CHARACTER(LEN=*), INTENT(IN)    :: IOTYPE
    INTEGER, INTENT(IN)             :: V_LIST (:)
    INTEGER, INTENT(OUT)            :: IOSTAT
    CHARACTER(LEN=*), INTENT(INOUT) :: IOMSG
    IOSTAT = 0
    PRINT *, SIZE (DTV%R)
    WRITE (UNIT, *) DTV%R
  END SUBROUTINE UDIO_WRITE_LD
END MODULE M

 
PROGRAM TEST2
  USE M
  TYPE (T)     :: X
  REAL, TARGET :: V (3)

  V = [ SIN (1.0), COS (1.0), TAN (1.0) ]
  X = T (R=V)
  PRINT *, X
END PROGRAM TEST2

TEST2 should print "3 0.8414710 0.5403023 1.557408".

Example 3

The following example shows user-defined derived-type NAMELIST input/output: 


! PROGRAM: udio_nml_read_write.f90
!
! This program tests NAMELIST READ and WRITE.  In the WRITE subroutine, there
! are FORMATTED WRITES as well as NAMELIST WRITES.
!
MODULE UDIO
  TYPE MYDT
     INTEGER F1
     INTEGER F2
   CONTAINS
     PROCEDURE :: MYSUBROUTINE
     GENERIC :: READ (FORMATTED) => MYSUBROUTINE
  END TYPE MYDT

  INTERFACE WRITE (FORMATTED)
     MODULE PROCEDURE :: WRITESUBROUTINE
  END INTERFACE
CONTAINS

  SUBROUTINE WRITESUBROUTINE (DTV, UNIT, IOTYPE, V_LIST, IOSTAT, IOMSG)
    CLASS (MYDT),	INTENT(IN)	:: DTV
    INTEGER*4,		INTENT(IN)	:: UNIT
    CHARACTER (LEN=*), 	INTENT(IN)	:: IOTYPE
    INTEGER,         	INTENT(IN)	:: V_LIST(:)
    INTEGER*4,		INTENT(OUT)	:: IOSTAT
    CHARACTER (LEN=*),	INTENT(INOUT)	:: IOMSG
 
    INTEGER I, J
    NAMELIST /SUBRT_NML/ I, J
 
    I=DTV%F1
    J=DTV%F2
 
    WRITE (UNIT, '(A,2I5.2)', IOSTAT=IOSTAT) IOTYPE, DTV%F1, DTV%F2
    WRITE (UNIT, NML=SUBRT_NML)
  END SUBROUTINE WRITESUBROUTINE
 
SUBROUTINE MYSUBROUTINE (DTV, UNIT, IOTYPE, V_LIST, IOSTAT, IOMSG)
    CLASS (MYDT),	INTENT(INOUT)	:: DTV
    INTEGER*4,		INTENT(IN)	:: UNIT
    CHARACTER (LEN=*), 	INTENT(IN)	:: IOTYPE
    INTEGER,         	INTENT(IN)	:: V_LIST(:)
    INTEGER*4,		INTENT(OUT)	:: IOSTAT
    CHARACTER (LEN=*),	INTENT(INOUT)	:: IOMSG
 
! X and Y are aliases for DTV%F1 and DTV%F2 since field references
! cannot be referenced in a NAMELIST statement
 
    INTEGER X, Y
    NAMELIST /SUBRT_NML/ X, Y
 
    READ (UNIT, *) DTV%F1, DTV%F2
 
    X = DTV%F1
    Y = DTV%F2
 
    READ (UNIT, NML=SUBRT_NML, IOSTAT=IOSTAT)
  
END SUBROUTINE MYSUBROUTINE

END MODULE UDIO

PROGRAM UDIO_PROGRAM
   USE UDIO
   TYPE (MYDT) :: MYDTV
   INTEGER        :: A, B
   NAMELIST /MAIN_NML/ A, MYDTV, B

   OPEN (10, FILE='udio_nml_read_write.in')
   READ (10, NML=MAIN_NML)
   WRITE (6, NML=MAIN_NML)
   CLOSE (10)
 
END PROGRAM UDIO_PROGRAM

The following shows input file 'udio_nml_read_write.in' on unit 10 read by MYSUBROUTINE: 

&MAIN_NML
A=100
MYDTV=20 30
&SUBRT_NML
X=20
Y=30
/
/B=200
/

The following shows output to unit 6 by WRITESUBROUTINE: 

&MAIN_NML
 A       =         100,
 MYDTV=NAMELIST   20   30
&SUBRT_NML
 I       =          20,
 J       =          30
/
 /B       =         200
/

Example 4

The following example shows user-defined derived-type UNFORMATTED input/output: 


! PROGRAM: udio_unformatted_1.f90
!
! This test first writes unformatted data to a file via user-defined derived type output
! and then reads the data from the file via user-defined derived type input.
!
MODULE UNFORMATTED
    TYPE UNFORMATTED_TYPE
        INTEGER              :: I
        CHARACTER*25 :: CHAR
    CONTAINS
        PROCEDURE :: MY_UNFMT_WRITE
        GENERIC :: WRITE (UNFORMATTED) => MY_UNFMT_WRITE
    END TYPE UNFORMATTED_TYPE
 
    INTERFACE READ (UNFORMATTED)
       MODULE PROCEDURE :: MY_UNFMT_READ
    END INTERFACE
 
CONTAINS
    SUBROUTINE MY_UNFMT_WRITE (DTV, UNIT, IOSTAT, IOMSG)
        CLASS (UNFORMATTED_TYPE), INTENT(IN)    :: DTV
        INTEGER,                  INTENT(IN)    :: UNIT
        INTEGER,                  INTENT(OUT)   :: IOSTAT
        CHARACTER(LEN=*),         INTENT(INOUT) :: IOMSG 

        WRITE (UNIT=UNIT, IOSTAT=IOSTAT, IOMSG=IOMSG) DTV%I+1, DTV%CHAR
    END SUBROUTINE MY_UNFMT_WRITE
 
    SUBROUTINE MY_UNFMT_READ (DTV, UNIT, IOSTAT, IOMSG)
        CLASS (UNFORMATTED_TYPE), INTENT(INOUT)  :: DTV
        INTEGER,                  INTENT(IN)     :: UNIT
        INTEGER,                  INTENT(OUT)    :: IOSTAT
        CHARACTER (LEN=*),        INTENT(INOUT)  :: IOMSG
         
        READ (UNIT=UNIT, IOSTAT=IOSTAT, IOMSG=IOMSG) DTV%I, DTV%CHAR
        DTV%I = 1-DTV%I
    END SUBROUTINE MY_UNFMT_READ
 
END MODULE UNFORMATTED
 
PROGRAM UNFORMATTED_WRITE_PROGRAM
    USE UNFORMATTED
     
    TYPE (UNFORMATTED_TYPE) :: READ_UNFORMATTED (1,2), UNFORMATTED_OBJECT (3:3,0:1)
    INTEGER :: IOSTAT    CHARACTER(LEN=100) :: IOMSG

    UNFORMATTED_OBJECT (3, 1) = UNFORMATTED_TYPE (I=71, CHAR='HELLO WORLD.')
    UNFORMATTED_OBJECT (3, 0) = UNFORMATTED_TYPE (I=72, CHAR='WORLD HELLO.')
 
    OPEN (UNIT=71, FILE='MYUNFORMATTED_DATA.DAT', FORM='UNFORMATTED')
    WRITE (UNIT=71) UNFORMATTED_OBJECT 
    CLOSE (UNIT=71)
 
    OPEN (UNIT=77, FILE='MYUNFORMATTED_DATA.DAT', FORM='UNFORMATTED')
    READ (UNIT=77) READ_UNFORMATTED
    CLOSE (UNIT=77)
 
    PRINT *, -READ_UNFORMATTED (:,1:2)%I .EQ. UNFORMATTED_OBJECT%I
    PRINT *, READ_UNFORMATTED%CHAR .EQ. UNFORMATTED_OBJECT%CHAR
 
END PROGRAM UNFORMATTED_WRITE_PROGRAM

The following shows output to unit * from program UNFORMATTED_WRITE_PROGRAM: 

T T
 T T
Parent topic: User-Defined Derived-Type I/O