Actual source code: ex49f.F90

  1: !
  2: !  Test Fortran binding of sort routines
  3: !
  4: module UserContext
  5:   use petsc
  6: #include "petsc/finclude/petsc.h"
  7:   implicit none
  8:   type uctx
  9:      PetscInt myint
 10:   end type uctx
 11: contains
 12:   subroutine CompareIntegers(a,b,ctx,res)
 13:     implicit none

 15:     PetscInt :: a,b
 16:     type(uctx) :: ctx
 17:     integer  :: res

 19:     if (a < b) then
 20:        res = -1
 21:     else if (a == b) then
 22:        res = 0
 23:     else
 24:        res = 1
 25:     end if
 26:     return
 27:   end subroutine CompareIntegers
 28: end module UserContext

 30: program main

 32:   use UserContext
 33:   implicit none

 35:   PetscErrorCode          ierr
 36:   PetscInt,parameter::    N=3
 37:   PetscMPIInt,parameter:: mN=3
 38:   PetscInt                x(N),x1(N),y(N),z(N)
 39:   PetscMPIInt             mx(N),my(N)
 40:   PetscScalar             s(N)
 41:   PetscReal               r(N)
 42:   PetscMPIInt,parameter:: two=2, five=5, seven=7
 43:   type(uctx)::            ctx
 44:   PetscInt                i
 45:   PetscSizeT              sizeofentry

 47:   call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 49:   x  = [3, 2, 1]
 50:   x1 = [3, 2, 1]
 51:   y  = [6, 5, 4]
 52:   z  = [3, 5, 2]
 53:   mx = [five, seven, two]
 54:   my = [five, seven, two]
 55:   s  = [1.0, 2.0, 3.0]
 56:   r  = [1.0, 2.0, 3.0]
 57: #if defined(PETSC_USE_64BIT_INDICES)
 58:   sizeofentry = 8;
 59: #else
 60:   sizeofentry = 4;
 61: #endif
 62:   ctx%myint = 1
 63:   call PetscSortInt(N,x,ierr)
 64:   call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr)
 65:   do i = 1,N
 66:      if (x1(i) .ne. x(i)) then
 67:         SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match")
 68:      end if
 69:   end do
 70:   call PetscSortIntWithArray(N,y,x,ierr)
 71:   call PetscSortIntWithArrayPair(N,x,y,z,ierr)

 73:   call PetscSortMPIInt(N,mx,ierr)
 74:   call PetscSortMPIIntWithArray(mN,mx,my,ierr)
 75:   call PetscSortMPIIntWithIntArray(mN,mx,y,ierr)

 77:   call PetscSortIntWithScalarArray(N,x,s,ierr)

 79:   call PetscSortReal(N,r,ierr)
 80:   call PetscSortRealWithArrayInt(N,r,x,ierr)

 82:   call PetscFinalize(ierr)
 83: end program main

 85: !/*TEST
 86: !
 87: !   test:
 88: !
 89: !TEST*/