1 program readheaderFtn 2 use iso_c_binding 3 use phio 4 use syncio 5 use posixio 6 use chdir_mod 7 include "mpif.h" 8 9 type :: ptrarr 10 real(c_double), pointer :: ptr(:,:) 11 end type ptrarr 12 13 integer :: rank, ierror, two, nfiles 14 type(c_ptr), dimension(2) :: handle 15 character(len=30) :: dataDbl, iotype 16 character(len=256) :: phrase 17 character(len=256), dimension(2) :: dir, fname 18 integer, target, dimension(2) :: numpts, ncoords 19 real(c_double), allocatable, target :: syncCoords(:,:), posixCoords(:,:) 20 type(ptrarr), target, dimension(2) :: coords 21 22 call MPI_Init(ierror) 23 call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) 24 25 coords(1)%ptr => syncCoords 26 coords(2)%ptr => posixCoords 27 28 phrase = c_char_"co-ordinates"//c_null_char 29 dataDbl = c_char_"double"//c_null_char 30 iotype = c_char_"binary"//c_null_char 31 two = 2 32 nfiles = 2 33 34 dir(1) = c_char_"4-procs_case-SyncIO-2"//c_null_char 35 dir(2) = c_char_"4-procs_case-Posix"//c_null_char 36 fname(1) = c_char_"geombc-dat."//c_null_char 37 fname(2) = c_char_"geombc.dat."//c_null_char 38 call syncio_setup_read(nfiles, handle(1)) 39 call posixio_setup(handle(2), c_char_"r"//c_null_char) 40 do i=1,2 41 call chdir(dir(i)) 42 call MPI_Barrier(MPI_COMM_WORLD, ierror) 43 call phio_openfile(fname(i), handle(i)) 44 call phio_readheader(handle(i), phrase, c_loc(numpts), 45 & two, dataDbl, iotype) 46 ncoords(i) = numpts(1)*numpts(2) 47 allocate( coords(i)%ptr(numpts(1),numpts(2)) ) 48 call phio_readdatablock(handle(i), phrase, 49 & c_loc(coords(i)%ptr), ncoords(i), dataDbl, iotype) 50 call phio_closefile(handle(i)) 51 call chdir(c_char_'..'//c_null_char) 52 end do 53 if( ncoords(1) .ne. ncoords(2) ) then 54 write (*,*) 'rank ncoords', rank, ncoords 55 stop 1 56 endif 57 do i=1,numpts(1) 58 do j=1,numpts(2) 59 if( coords(1)%ptr(i,j) .ne. coords(2)%ptr(i,j) ) then 60 write (*,*) 'rank coordinate mismatch i,j', rank, i, j 61 stop 1 62 end if 63 end do 64 end do 65 deallocate(coords(1)%ptr) 66 deallocate(coords(2)%ptr) 67 call MPI_Finalize(ierror) 68 end 69