! ! Copyright (C) by Argonne National Laboratory ! See COPYRIGHT in top-level directory ! program main implicit none include 'mpif.h' @F77MPIOINC@ ! Fortran equivalent of misc.c ! tests various miscellaneous functions. integer buf(1024), amode, fh, status(MPI_STATUS_SIZE) logical flag integer ierr, newtype, i, group integer etype, filetype, mynod, argc, iargc integer errs, toterrs logical verbose character*7 datarep character*1024 str ! used to store the filename @FORTRAN_MPI_OFFSET@ disp, offset, filesize errs = 0 verbose = .false. call MPI_INIT(ierr) call MPI_COMM_RANK(MPI_COMM_WORLD, mynod, ierr) ! process 0 takes the file name as a command-line argument and ! broadcasts it to other processes if (mynod .eq. 0) then argc = @F77IARGC@ i = 0 @F77GETARG@ do while ((i .lt. argc) .and. (str .ne. '-fname')) i = i + 1 @F77GETARG@ end do if (i .ge. argc) then print * print *, '*# Usage: fmisc -fname filename' print * call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) end if i = i + 1 @F77GETARG@ call MPI_BCAST(str, 1024, MPI_CHARACTER, 0, & & MPI_COMM_WORLD, ierr) else call MPI_BCAST(str, 1024, MPI_CHARACTER, 0, & & MPI_COMM_WORLD, ierr) end if call MPI_FILE_OPEN(MPI_COMM_WORLD, str, & & MPI_MODE_CREATE + MPI_MODE_RDWR, MPI_INFO_NULL, fh, ierr) call MPI_FILE_WRITE(fh, buf, 1024, MPI_INTEGER, status, ierr) call MPI_FILE_SYNC(fh, ierr) call MPI_FILE_GET_AMODE(fh, amode, ierr) if (mynod .eq. 0 .and. verbose) then print *, ' testing MPI_FILE_GET_AMODE' end if if (amode .ne. (MPI_MODE_CREATE + MPI_MODE_RDWR)) then errs = errs + 1 print *, 'amode is ', amode, ', should be ', MPI_MODE_CREATE & & + MPI_MODE_RDWR end if call MPI_FILE_GET_ATOMICITY(fh, flag, ierr) if (flag) then errs = errs + 1 print *, 'atomicity is ', flag, ', should be .FALSE.' end if if (mynod .eq. 0 .and. verbose) then print *, ' setting atomic mode' end if call MPI_FILE_SET_ATOMICITY(fh, .TRUE., ierr) call MPI_FILE_GET_ATOMICITY(fh, flag, ierr) if (.not. flag) then errs = errs + 1 print *, 'atomicity is ', flag, ', should be .TRUE.' end if call MPI_FILE_SET_ATOMICITY(fh, .FALSE., ierr) if (mynod .eq. 0 .and. verbose) then print *, ' reverting back to nonatomic mode' end if call MPI_TYPE_VECTOR(10, 10, 20, MPI_INTEGER, newtype, ierr) call MPI_TYPE_COMMIT(newtype, ierr) disp = 1000 call MPI_FILE_SET_VIEW(fh, disp, MPI_INTEGER, newtype, 'native', & & MPI_INFO_NULL, ierr) if (mynod .eq. 0 .and. verbose) then print *, ' testing MPI_FILE_GET_VIEW' end if disp = 0 call MPI_FILE_GET_VIEW(fh, disp, etype, filetype, datarep, ierr) if ((disp .ne. 1000) .or. (datarep .ne. 'native')) then errs = errs + 1 print *, 'disp = ', disp, ', datarep = ', datarep, & & ', should be 1000, native' end if if (mynod .eq. 0 .and. verbose) then print *, ' testing MPI_FILE_GET_BYTE_OFFSET' end if offset = 10 call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr) if (disp .ne. 1080) then errs = errs + 1 print *, 'byte offset = ', disp, ', should be 1080' end if call MPI_FILE_GET_GROUP(fh, group, ierr) if (mynod .eq. 0 .and. verbose) then print *, ' setting file size to 1060 bytes' end if filesize = 1060 call MPI_FILE_SET_SIZE(fh, filesize, ierr) call MPI_BARRIER(MPI_COMM_WORLD, ierr) call MPI_FILE_SYNC(fh, ierr) filesize = 0 call MPI_FILE_GET_SIZE(fh, filesize, ierr) if (filesize .ne. 1060) then errs = errs + 1 print *, 'file size = ', filesize, ', should be 1060' end if if (mynod .eq. 0 .and. verbose) then print *, ' seeking to eof and testing MPI_FILE_GET_POSITION' end if offset = 0 call MPI_FILE_SEEK(fh, offset, MPI_SEEK_END, ierr) call MPI_FILE_GET_POSITION(fh, offset, ierr) if (offset .ne. 10) then errs = errs + 1 print *, 'file pointer posn = ', offset, ', should be 10' end if if (mynod .eq. 0 .and. verbose) then print *, ' testing MPI_FILE_GET_BYTE_OFFSET' end if call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr) if (disp .ne. 1080) then errs = errs + 1 print *, 'byte offset = ', disp, ', should be 1080' end if call MPI_BARRIER(MPI_COMM_WORLD, ierr) if (mynod .eq. 0 .and. verbose) then print *, ' testing MPI_FILE_SEEK with MPI_SEEK_CUR' end if offset = -10 call MPI_FILE_SEEK(fh, offset, MPI_SEEK_CUR, ierr) call MPI_FILE_GET_POSITION(fh, offset, ierr) call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr) if (disp .ne. 1000) then errs = errs + 1 print *, 'file pointer posn in bytes = ', disp, & & ', should be 1000' end if if (mynod .eq. 0 .and. verbose) then print *, ' preallocating disk space up to 8192 bytes' end if filesize = 8192 call MPI_FILE_PREALLOCATE(fh, filesize, ierr) if (mynod .eq. 0 .and. verbose) then print *, ' closing the file and deleting it' end if call MPI_FILE_CLOSE(fh, ierr) call MPI_BARRIER(MPI_COMM_WORLD, ierr) if (mynod .eq. 0) then call MPI_FILE_DELETE(str, MPI_INFO_NULL, ierr) end if call MPI_Allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, & $ MPI_COMM_WORLD, ierr ) if (mynod .eq. 0) then if( toterrs .gt. 0 ) then print *, 'Found ', toterrs, ' errors' else print *, ' No Errors' endif endif call MPI_TYPE_FREE(newtype, ierr) call MPI_TYPE_FREE(filetype, ierr) call MPI_GROUP_FREE(group, ierr) call MPI_FINALIZE(ierr) end