Blame test/mpi/f90/io/setviewcurf90.f90

Packit 0848f5
! This file created from test/mpi/f77/io/setviewcurf.f with f77tof90
Packit 0848f5
! -*- Mode: Fortran; -*-
Packit 0848f5
!
Packit 0848f5
!  (C) 2003 by Argonne National Laboratory.
Packit 0848f5
!      See COPYRIGHT in top-level directory.
Packit 0848f5
!
Packit 0848f5
      program main
Packit 0848f5
      use mpi
Packit 0848f5
      integer (kind=MPI_OFFSET_KIND) offset
Packit 0848f5
Packit 0848f5
      integer errs, ierr, size, rank
Packit 0848f5
      integer fh, comm, status(MPI_STATUS_SIZE)
Packit 0848f5
      integer buf(1024)
Packit 0848f5
Packit 0848f5
      errs = 0
Packit 0848f5
      call MTest_Init( ierr )
Packit 0848f5
Packit 0848f5
!    This test reads a header then sets the view to every "size" int,
Packit 0848f5
!    using set view and current displacement.  The file is first written
Packit 0848f5
!    using a combination of collective and ordered writes 
Packit 0848f5
      
Packit 0848f5
      comm = MPI_COMM_WORLD
Packit 0848f5
      call MPI_File_open( comm, "test.ord", MPI_MODE_WRONLY + &
Packit 0848f5
      &     MPI_MODE_CREATE, MPI_INFO_NULL, fh, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         call MTestPrintErrorMsg( "Open(1)", ierr )
Packit 0848f5
      endif
Packit 0848f5
      call MPI_Comm_size( comm, size, ierr )
Packit 0848f5
      call MPI_Comm_rank( comm, rank, ierr )
Packit 0848f5
      if (size .gt. 1024) then
Packit 0848f5
         if (rank .eq. 0) then
Packit 0848f5
            print *,  &
Packit 0848f5
      &"This program must be run with no more than 1024 processes"
Packit 0848f5
            call MPI_Abort( MPI_COMM_WORLD, 1, ierr )
Packit 0848f5
         endif
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      buf(1) = size
Packit 0848f5
      call MPI_File_write_all( fh, buf, 1, MPI_INTEGER, status, ierr ) 
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         call MTestPrintErrorMsg( "Write_all", ierr )
Packit 0848f5
      endif
Packit 0848f5
      call MPI_File_get_position( fh, offset, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1 
Packit 0848f5
         call MTestPrintErrorMsg( "Get_position", ierr )
Packit 0848f5
      endif
Packit 0848f5
      call MPI_File_seek_shared( fh, offset, MPI_SEEK_SET, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         call MTestPrintErrorMsg( "Seek_shared", ierr )
Packit 0848f5
      endif
Packit 0848f5
      buf(1) = rank
Packit 0848f5
      call MPI_File_write_ordered( fh, buf, 1, MPI_INTEGER, status,ierr)
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         call MTestPrintErrorMsg( "Write_ordered", ierr )
Packit 0848f5
      endif
Packit 0848f5
      call MPI_File_close( fh, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1 
Packit 0848f5
         call MTestPrintErrorMsg( "Close(1)", ierr ) 
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
! Reopen the file as sequential 
Packit 0848f5
      call MPI_File_open( comm, "test.ord", MPI_MODE_RDONLY + &
Packit 0848f5
      &     MPI_MODE_SEQUENTIAL + MPI_MODE_DELETE_ON_CLOSE, &
Packit 0848f5
      &     MPI_INFO_NULL, fh, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1 
Packit 0848f5
         call MTestPrintErrorMsg( "Open(Read)", ierr )
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      if (rank .eq. 0) then
Packit 0848f5
         call MPI_File_read_shared( fh, buf, 1, MPI_INTEGER, status, &
Packit 0848f5
      &        ierr ) 
Packit 0848f5
         if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
            errs = errs + 1
Packit 0848f5
            call MTestPrintErrorMsg( "Read_all", ierr )
Packit 0848f5
         endif
Packit 0848f5
         if (buf(1) .ne. size) then
Packit 0848f5
           errs = errs + 1
Packit 0848f5
           print *, "Unexpected value for the header = ", buf(1), &
Packit 0848f5
      &          ", should be ", size 
Packit 0848f5
        endif
Packit 0848f5
      endif
Packit 0848f5
      call MPI_Barrier( comm, ierr  )
Packit 0848f5
!   All processes must provide the same file view for MODE_SEQUENTIAL
Packit 0848f5
      call MPI_File_set_view( fh, MPI_DISPLACEMENT_CURRENT, MPI_INTEGER &
Packit 0848f5
      &     ,MPI_INTEGER, "native", MPI_INFO_NULL, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1 
Packit 0848f5
         call MTestPrintErrorMsg( "Set_view", ierr )
Packit 0848f5
      endif
Packit 0848f5
      buf(1) = -1
Packit 0848f5
      call MPI_File_read_ordered( fh, buf, 1, MPI_INTEGER, status, ierr &
Packit 0848f5
      &     ) 
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then 
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         call MTestPrintErrorMsg( "Read_all", ierr )
Packit 0848f5
      endif
Packit 0848f5
      if (buf(1) .ne. rank) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         print *, rank, ": buf(1) = ", buf(1)
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      call MPI_File_close( fh, ierr )
Packit 0848f5
      if (ierr .ne. MPI_SUCCESS) then
Packit 0848f5
         errs = errs + 1 
Packit 0848f5
         call MTestPrintErrorMsg( "Close(2)", ierr )
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      call MTest_Finalize( errs )
Packit 0848f5
Packit 0848f5
      call MPI_Finalize( ierr )
Packit 0848f5
      end
Packit 0848f5