1! Program to test IO of derived types 2program derived_io 3 character(400) :: buf1, buf2, buf3 4 5 type xyz_type 6 integer :: x 7 character(11) :: y 8 logical :: z 9 end type xyz_type 10 11 type abcdef_type 12 integer :: a 13 logical :: b 14 type (xyz_type) :: c 15 integer :: d 16 real(4) :: e 17 character(11) :: f 18 end type abcdef_type 19 20 type (xyz_type), dimension(2) :: xyz 21 type (abcdef_type) abcdef 22 23 xyz(1)%x = 11111 24 xyz(1)%y = "hello world" 25 xyz(1)%z = .true. 26 xyz(2)%x = 0 27 xyz(2)%y = "go away" 28 xyz(2)%z = .false. 29 30 abcdef%a = 0 31 abcdef%b = .true. 32 abcdef%c%x = 111 33 abcdef%c%y = "bzz booo" 34 abcdef%c%z = .false. 35 abcdef%d = 3 36 abcdef%e = 4.0 37 abcdef%f = "kawabanga" 38 39 write (buf1, *), xyz(1)%x, xyz(1)%y, xyz(1)%z 40 ! Use function call to ensure it is only evaluated once 41 write (buf2, *), xyz(bar()) 42 if (buf1.ne.buf2) STOP 1 43 44 write (buf1, *), abcdef 45 write (buf2, *), abcdef%a, abcdef%b, abcdef%c, abcdef%d, abcdef%e, abcdef%f 46 write (buf3, *), abcdef%a, abcdef%b, abcdef%c%x, abcdef%c%y, & 47 abcdef%c%z, abcdef%d, abcdef%e, abcdef%f 48 if (buf1.ne.buf2) STOP 2 49 if (buf1.ne.buf3) STOP 3 50 51 call foo(xyz(1)) 52 53 contains 54 55 subroutine foo(t) 56 type (xyz_type) t 57 write (buf1, *), t%x, t%y, t%z 58 write (buf2, *), t 59 if (buf1.ne.buf2) STOP 4 60 end subroutine foo 61 62 integer function bar() 63 integer, save :: i = 1 64 bar = i 65 i = i + 1 66 end function 67end 68