1 program readheaderFtn 2 use iso_c_binding 3 use phio 4 use syncio 5 use posixio 6 include "mpif.h" 7 8 integer, target :: rank, ierror, one, ppf, peers, fish, nfiles 9 type(c_ptr), dimension(2) :: handle 10 character(len=30) :: dataDbl, iotype 11 character(len=256) :: phrase 12 character(len=256), dimension(2) :: fname 13 integer, target, dimension(2) :: fishweight, numFish 14 15 call MPI_Init(ierror) 16 call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) 17 call MPI_Comm_size(MPI_COMM_WORLD, peers, ierror) 18 19 phrase = c_char_"number of fishes"//c_null_char 20 dataDbl = c_char_"double"//c_null_char 21 iotype = c_char_"binary"//c_null_char 22 one = 1 23 fish = 2 24 25 fishweight(1) = 1.23 26 fishweight(2) = 1.23 27 28 fname(1) = c_char_"fortranWater-dat."//c_null_char 29 fname(2) = c_char_"fortranWater.dat."//c_null_char 30 nfiles = 2 31 ppf = peers/nfiles 32 ! handle(1) is the file for syncio writing 33 call syncio_setup_write(nfiles, one, ppf, handle(1)) 34 ! handle(2) is the file for posix writing 35 call posixio_setup(handle(2), c_char_"w"//c_null_char) 36 ! if there were a handle(3) for streams we would do the following 37 ! call streamio_setup_write(handle(3), <stream obj>) 38 ! after the handles are setup the function calls are the same 39 ! write the same garbage to posix and syncio files 40 do i=1,2 41 call phio_openfile(fname(i), handle(i)) 42 call phio_writeheader(handle(i), phrase, c_loc(fish), one, one, 43 & dataDbl, iotype) 44 call phio_writedatablock(handle(i), phrase, c_loc(fishweight(i)), 45 & one, dataDbl, iotype) 46 call phio_closefile(handle(i)) 47 end do 48 ! this is the read side... less interesting for us 49 call syncio_setup_read(nfiles, handle(1)) 50 call posixio_setup(handle(2), c_char_"r"//c_null_char) 51 do i=1,2 52 call phio_openfile(fname(i), handle(i)) 53 call phio_readheader(handle(i), phrase, c_loc(numFish(i)), 54 & one, dataDbl, iotype) 55 call phio_readdatablock(handle(i), phrase, c_loc(fishweight(i)), 56 & one, dataDbl, iotype) 57 call phio_closefile(handle(i)) 58 end do 59 if( numFish(1) .ne. numFish(2) .or. 60 & fishweight(1) .ne. fishweight(2) ) then 61 write (*,*) "fish don\'t match" 62 stop 1 63 end if 64 call MPI_Finalize(ierror) 65 end 66