Dear all,
I have experienced a problem that I cannot explain and probably someone can help me or give me some insight. The simplified code which is giving me a headache is bellow and it is basically a program that writes two numbers of a derived type in a file and then it reads the file both using a user defined write and read. When I compile and execute the code with
ifort test.f90 -o test
everything is correct and the program write and read the correct values, namely 1 and 2. However when I use "ipo" optimization, it reads as
ifort test.f90 -ipo -o test
then when I execute the program it breaks at the "write" user defined i/o derived type with the following message
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image PC Routine Line Source
test 0000000000473319 Unknown Unknown Unknown
test 0000000000471BEE Unknown Unknown Unknown
test 00000000004300E2 Unknown Unknown Unknown
test 0000000000406443 Unknown Unknown Unknown
test 0000000000409E0B Unknown Unknown Unknown
libpthread.so.0 0000003143C0F710 Unknown Unknown Unknown
test 00000000006A6B50 Unknown Unknown Unknown
I have looked for in internet and actually I am following the way of defined i/o as it is recommended in many specialize web pages however I am not able to understand why ipo fails.
Thanks,
Dani.
module m_data_kind
implicit none
type field_face
real, allocatable, dimension(:,:) :: uf
CONTAINS
PROCEDURE :: MY_ff_WRITE
PROCEDURE :: MY_ff_READ
GENERIC :: WRITE(UNFORMATTED) => MY_ff_WRITE
GENERIC :: READ(UNFORMATTED) => MY_ff_READ
end type field_face
type field
real, allocatable, dimension(:,:) :: u
type(field_face) :: f
CONTAINS
PROCEDURE :: MY_f_WRITE
PROCEDURE :: MY_f_READ
GENERIC :: WRITE(UNFORMATTED) => MY_f_WRITE
GENERIC :: READ(UNFORMATTED) => MY_f_READ
end type field
!----------------------------------------------------------!
CONTAINS
SUBROUTINE MY_ff_WRITE( ff, UNIT, IOSTAT, IOMSG )
CLASS(field_face), INTENT(IN) :: ff
INTEGER, INTENT(IN) :: UNIT
INTEGER, INTENT(OUT) :: IOSTAT
CHARACTER(LEN=*), INTENT(INOUT) :: IOMSG
WRITE(UNIT=UNIT,IOSTAT=IOSTAT,IOMSG=IOMSG) ff%uf
END SUBROUTINE MY_ff_WRITE
SUBROUTINE MY_f_WRITE( f, UNIT, IOSTAT, IOMSG )
CLASS(field), INTENT(IN) :: f
INTEGER, INTENT(IN) :: UNIT
INTEGER, INTENT(OUT) :: IOSTAT
CHARACTER(LEN=*), INTENT(INOUT) :: IOMSG
WRITE(UNIT=UNIT,IOSTAT=IOSTAT,IOMSG=IOMSG) f%u
END SUBROUTINE MY_f_WRITE
SUBROUTINE MY_ff_read( ff, UNIT, IOSTAT, IOMSG )
CLASS(field_face), INTENT(INOUT) :: ff
INTEGER, INTENT(IN) :: UNIT
INTEGER, INTENT(OUT) :: IOSTAT
CHARACTER(LEN=*), INTENT(INOUT) :: IOMSG
read(UNIT=UNIT,IOSTAT=IOSTAT,IOMSG=IOMSG) ff%uf
END SUBROUTINE MY_ff_read
SUBROUTINE MY_f_read( f, UNIT, IOSTAT, IOMSG )
CLASS(field), INTENT(INOUT) :: f
INTEGER, INTENT(IN) :: UNIT
INTEGER, INTENT(OUT) :: IOSTAT
CHARACTER(LEN=*), INTENT(INOUT) :: IOMSG
read(UNIT=UNIT,IOSTAT=IOSTAT,IOMSG=IOMSG) f%u
END SUBROUTINE MY_f_read
end module m_data_kind
!**********************************************************!
program shot
use m_data_kind
type(field) :: vf
allocate( vf%u(5,5), vf%f%uf(5,5) )
vf%u(5,1) = 1.
vf%u(1,5) = 2.
write(*,*) vf%u(5,1)
write(*,*) vf%u(1,5)
open(unit=1,file='hello.txt',status='unknown',action='write',form='unformatted')
write(1) vf
close(1)
open(unit=1,file='hello.txt',status='unknown',action='read',form='unformatted')
read(1) vf
close(1)
write(*,*) vf%u(5,1)
write(*,*) vf%u(1,5)
deallocate( vf%u, vf%f%uf )
end program shot