source-git / mpich

Clone
Source Code
GIT

Blame test/mpi/f08/attr/fandcattrf08.f90

c8 c8s master
  1.   5dd33b50fd2306565c14eb5dbf683b3e3a4a92a5
  2.   test
  3.   mpi
  4.   f08
  5.   attr
  6.   fandcattrf08.f90
Blob History Raw
Packit Service c5cf8c 
! -*- Mode: Fortran; -*-
Packit Service c5cf8c 
!
Packit Service c5cf8c 
!  (C) 2008 by Argonne National Laboratory.
Packit Service c5cf8c 
!      See COPYRIGHT in top-level directory.
Packit Service c5cf8c 
!
Packit Service c5cf8c 
!
Packit Service c5cf8c 
! To do: Create a keyval from c, then change the attribute from Fortran,
Packit Service c5cf8c 
! then dup.  The C attribute copy function should be passed a pointer to
Packit Service c5cf8c 
! the Fortran attribute value (e.g., it should dereference it to check
Packit Service c5cf8c 
! its value)
Packit Service c5cf8c 
!
Packit Service c5cf8c 
      program main
Packit Service c5cf8c 
      use mpi_f08
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) val
Packit Service c5cf8c 
      integer ierr, errs, fcomm2_keyval, ftype2_keyval
Packit Service c5cf8c 
      integer ccomm2_keyval, ctype2_keyval, cwin2_keyval
Packit Service c5cf8c 
      integer callcount, delcount
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) commextra, typeextra
Packit Service c5cf8c 
      common /myattr/ callcount, delcount
Packit Service c5cf8c 
      external mycopyfn, mydelfn, mytcopyfn, mytdelfn
Packit Service c5cf8c
Packit Service c5cf8c 
      callcount = 0
Packit Service c5cf8c 
      delcount  = 0
Packit Service c5cf8c
Packit Service c5cf8c 
      errs      = 0
Packit Service c5cf8c 
      call mpi_init(ierr)
Packit Service c5cf8c 
      commextra = 1001
Packit Service c5cf8c 
      call mpi_comm_create_keyval( mycopyfn, mydelfn,                     &
Packit Service c5cf8c 
     &                             fcomm2_keyval, commextra, ierr )
Packit Service c5cf8c 
      typeextra = 2001
Packit Service c5cf8c 
      call mpi_type_create_keyval( mytcopyfn, mytdelfn,                   &
Packit Service c5cf8c 
                                   ftype2_keyval, typeextra, ierr )
Packit Service c5cf8c 
      call chkckeyvals( ccomm2_keyval, ctype2_keyval, cwin2_keyval )
Packit Service c5cf8c
Packit Service c5cf8c 
      ! Address-sized ints may be 32, 64, or something else in size;
Packit Service c5cf8c 
      ! we can't assume any particular size.  We can use the Fortran 90
Packit Service c5cf8c 
      ! intrinsic range to determine the available size and compute
Packit Service c5cf8c 
      ! a suitable value.
Packit Service c5cf8c 
      val = 5555
Packit Service c5cf8c 
      call mpi_comm_set_attr( MPI_COMM_WORLD, fcomm2_keyval, val, ierr )
Packit Service c5cf8c
Packit Service c5cf8c 
      call chkcomm2inc( fcomm2_keyval, 5555, errs )
Packit Service c5cf8c
Packit Service c5cf8c 
      call mpi_comm_free_keyval( fcomm2_keyval, ierr )
Packit Service c5cf8c 
      call mpi_type_free_keyval( ftype2_keyval, ierr )
Packit Service c5cf8c
Packit Service c5cf8c 
      call mpi_comm_free_keyval( ccomm2_keyval, ierr )
Packit Service c5cf8c 
      call mpi_type_free_keyval( ctype2_keyval, ierr )
Packit Service c5cf8c 
      call mpi_win_free_keyval( cwin2_keyval, ierr )
Packit Service c5cf8c
Packit Service c5cf8c 
      if (errs .eq. 0) then
Packit Service c5cf8c 
         print *, ' No Errors'
Packit Service c5cf8c 
      else
Packit Service c5cf8c 
         print *, ' Found ', errs, ' errors'
Packit Service c5cf8c 
      endif
Packit Service c5cf8c
Packit Service c5cf8c 
      end
Packit Service c5cf8c 
!
Packit Service c5cf8c 
      subroutine mycopyfn( oldcomm, keyval, extrastate, valin, valout, &
Packit Service c5cf8c 
      &                     flag, ierr )
Packit Service c5cf8c 
      use mpi_f08
Packit Service c5cf8c 
      integer keyval, ierr
Packit Service c5cf8c 
      TYPE(MPI_Comm) oldcomm
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
Packit Service c5cf8c
Packit Service c5cf8c 
      logical flag
Packit Service c5cf8c 
      integer callcount, delcount
Packit Service c5cf8c 
      common /myattr/ callcount, delcount
Packit Service c5cf8c 
! increment the attribute by 2
Packit Service c5cf8c 
      valout = valin + 2
Packit Service c5cf8c 
      callcount = callcount + 1
Packit Service c5cf8c 
      if (extrastate .eq. 1001) then
Packit Service c5cf8c 
         flag = .true.
Packit Service c5cf8c 
         ierr = MPI_SUCCESS
Packit Service c5cf8c 
      else
Packit Service c5cf8c 
         print *, ' Unexpected value of extrastate = ', extrastate
Packit Service c5cf8c 
         flag = .false.
Packit Service c5cf8c 
         ierr = MPI_ERR_OTHER
Packit Service c5cf8c 
      endif
Packit Service c5cf8c 
      end
Packit Service c5cf8c 
!
Packit Service c5cf8c 
      subroutine mydelfn( comm, keyval, val, extrastate, ierr )
Packit Service c5cf8c 
      use mpi_f08
Packit Service c5cf8c 
      integer keyval, ierr
Packit Service c5cf8c 
      TYPE(MPI_Comm) comm
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
Packit Service c5cf8c
Packit Service c5cf8c 
      integer callcount, delcount
Packit Service c5cf8c 
      common /myattr/ callcount, delcount
Packit Service c5cf8c 
      delcount = delcount + 1
Packit Service c5cf8c 
      if (extrastate .eq. 1001) then
Packit Service c5cf8c 
         ierr = MPI_SUCCESS
Packit Service c5cf8c 
      else
Packit Service c5cf8c 
         print *, ' Unexpected value of extrastate = ', extrastate
Packit Service c5cf8c 
         ierr = MPI_ERR_OTHER
Packit Service c5cf8c 
      endif
Packit Service c5cf8c 
      end
Packit Service c5cf8c 
!
Packit Service c5cf8c 
      subroutine mytcopyfn( oldtype, keyval, extrastate, valin, valout, &
Packit Service c5cf8c 
      &                     flag, ierr )
Packit Service c5cf8c 
      use mpi_f08
Packit Service c5cf8c 
      integer keyval, ierr
Packit Service c5cf8c 
      TYPE(MPI_Datatype) oldtype
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
Packit Service c5cf8c
Packit Service c5cf8c 
      logical flag
Packit Service c5cf8c 
      integer callcount, delcount
Packit Service c5cf8c 
      common /myattr/ callcount, delcount
Packit Service c5cf8c 
! increment the attribute by 2
Packit Service c5cf8c 
      valout = valin + 2
Packit Service c5cf8c 
      callcount = callcount + 1
Packit Service c5cf8c 
      if (extrastate .eq. 2001) then
Packit Service c5cf8c 
         flag = .true.
Packit Service c5cf8c 
         ierr = MPI_SUCCESS
Packit Service c5cf8c 
      else
Packit Service c5cf8c 
         print *, ' Unexpected value of extrastate = ', extrastate
Packit Service c5cf8c 
         flag = .false.
Packit Service c5cf8c 
         ierr = MPI_ERR_OTHER
Packit Service c5cf8c 
      endif
Packit Service c5cf8c 
      end
Packit Service c5cf8c 
!
Packit Service c5cf8c 
      subroutine mytdelfn( dtype, keyval, val, extrastate, ierr )
Packit Service c5cf8c 
      use mpi_f08
Packit Service c5cf8c 
      integer keyval, ierr
Packit Service c5cf8c 
      TYPE(MPI_Datatype) dtype
Packit Service c5cf8c 
      integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
Packit Service c5cf8c
Packit Service c5cf8c 
      integer callcount, delcount
Packit Service c5cf8c 
      common /myattr/ callcount, delcount
Packit Service c5cf8c 
      delcount = delcount + 1
Packit Service c5cf8c 
      if (extrastate .eq. 2001) then
Packit Service c5cf8c 
         ierr = MPI_SUCCESS
Packit Service c5cf8c 
      else
Packit Service c5cf8c 
         print *, ' Unexpected value of extrastate = ', extrastate
Packit Service c5cf8c 
         ierr = MPI_ERR_OTHER
Packit Service c5cf8c 
      endif
Packit Service c5cf8c 
      end

Powered by Pagure 5.14.1

SSH Hostkey/Fingerprint | Documentation