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