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, target, dimension(2) :: nfiles, numpts, ncoords 17 real(c_double), allocatable, target :: syncCoords(:,:), posixCoords(:,:) 18 type(ptrarr), target, 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 call phio_openfile_read(fname(i), nfiles(i), handle) 41 call phio_readheader(handle, phrase, c_loc(numpts), 42 & two, dataDbl, iotype) 43 ncoords(i) = numpts(1)*numpts(2) 44 allocate( coords(i)%ptr(numpts(1),numpts(2)) ) 45 call phio_readdatablock(handle, phrase, 46 & c_loc(coords(i)%ptr), ncoords(i), dataDbl, iotype) 47 call phio_closefile_read(handle) 48 call chdir(c_char_'..'//c_null_char) 49 end do 50 if( ncoords(1) .ne. ncoords(2) ) then 51 write (*,*) 'rank ncoords', rank, ncoords 52 stop 1 53 endif 54 do i=1,numpts(1) 55 do j=1,numpts(2) 56 if( coords(1)%ptr(i,j) .ne. coords(2)%ptr(i,j) ) then 57 write (*,*) 'rank coordinate mismatch i,j', rank, i, j 58 stop 1 59 end if 60 end do 61 end do 62 deallocate(coords(1)%ptr) 63 deallocate(coords(2)%ptr) 64 call MPI_Finalize(ierror) 65 end 66