xref: /phasta/phSolver/common/test/phIOread.f (revision d7abaf6c7709145d1e6e6b7740bd56c3f238d064)
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
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
33      dir(1) = c_char_"4-procs_case-SyncIO-2"//c_null_char
34      dir(2) = c_char_"4-procs_case-Posix"//c_null_char
35      fname(1) = c_char_"geombc-dat."//c_null_char
36      fname(2) = c_char_"geombc.dat."//c_null_char
37      call syncio_setup_read(2, handle(1))
38      call posixio_setup(handle(2), c_char_"r"//c_null_char)
39      do i=1,2
40        call chdir(dir(i))
41        call MPI_Barrier(MPI_COMM_WORLD, ierror)
42        call phio_openfile(fname(i), handle)
43        call phio_readheader(handle, phrase, c_loc(numpts),
44     &      two, dataDbl, iotype)
45        ncoords(i) = numpts(1)*numpts(2)
46        allocate( coords(i)%ptr(numpts(1),numpts(2)) )
47        call phio_readdatablock(handle, phrase,
48     &      c_loc(coords(i)%ptr), ncoords(i), dataDbl, iotype)
49        call phio_closefile(handle)
50        call chdir(c_char_'..'//c_null_char)
51      end do
52      if( ncoords(1) .ne. ncoords(2) ) then
53        write (*,*) 'rank ncoords', rank, ncoords
54        stop 1
55      endif
56      do i=1,numpts(1)
57        do j=1,numpts(2)
58          if( coords(1)%ptr(i,j) .ne. coords(2)%ptr(i,j) ) then
59            write (*,*) 'rank coordinate mismatch i,j', rank, i, j
60            stop 1
61          end if
62        end do
63      end do
64      deallocate(coords(1)%ptr)
65      deallocate(coords(2)%ptr)
66      call MPI_Finalize(ierror)
67      end
68