1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Test Fortran binding of sort routines 3c4762a1bSJed Brown! 4*4d3610e3SJacob Faibussowitschmodule UserContext 5c4762a1bSJed Brown use petsc 6*4d3610e3SJacob Faibussowitsch#include "petsc/finclude/petsc.h" 7*4d3610e3SJacob Faibussowitsch implicit none 8*4d3610e3SJacob Faibussowitsch type uctx 9*4d3610e3SJacob Faibussowitsch PetscInt myint 10*4d3610e3SJacob Faibussowitsch end type uctx 11*4d3610e3SJacob Faibussowitschcontains 12*4d3610e3SJacob Faibussowitsch subroutine CompareIntegers(a,b,ctx,res) 13*4d3610e3SJacob Faibussowitsch implicit none 14*4d3610e3SJacob Faibussowitsch 15*4d3610e3SJacob Faibussowitsch PetscInt :: a,b 16*4d3610e3SJacob Faibussowitsch type(uctx) :: ctx 17*4d3610e3SJacob Faibussowitsch integer :: res 18*4d3610e3SJacob Faibussowitsch 19*4d3610e3SJacob Faibussowitsch if (a < b) then 20*4d3610e3SJacob Faibussowitsch res = -1 21*4d3610e3SJacob Faibussowitsch else if (a == b) then 22*4d3610e3SJacob Faibussowitsch res = 0 23*4d3610e3SJacob Faibussowitsch else 24*4d3610e3SJacob Faibussowitsch res = 1 25*4d3610e3SJacob Faibussowitsch end if 26*4d3610e3SJacob Faibussowitsch return 27*4d3610e3SJacob Faibussowitsch end subroutine CompareIntegers 28*4d3610e3SJacob Faibussowitschend module UserContext 29*4d3610e3SJacob Faibussowitsch 30*4d3610e3SJacob Faibussowitschprogram main 31*4d3610e3SJacob Faibussowitsch 32*4d3610e3SJacob Faibussowitsch use UserContext 33c4762a1bSJed Brown implicit none 34c4762a1bSJed Brown 35c4762a1bSJed Brown PetscErrorCode ierr 36c4762a1bSJed Brown PetscInt,parameter:: N=3 37c4762a1bSJed Brown PetscMPIInt,parameter:: mN=3 38*4d3610e3SJacob Faibussowitsch PetscInt x(N),x1(N),y(N),z(N) 39c4762a1bSJed Brown PetscMPIInt mx(N),my(N),mz(N) 40c4762a1bSJed Brown PetscScalar s(N) 41c4762a1bSJed Brown PetscReal r(N) 42c4762a1bSJed Brown PetscMPIInt,parameter:: two=2, five=5, seven=7 43*4d3610e3SJacob Faibussowitsch type(uctx):: ctx 44*4d3610e3SJacob Faibussowitsch PetscInt dummyint, i 45*4d3610e3SJacob Faibussowitsch PetscSizeT sizeofentry 46c4762a1bSJed Brown 47c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 48c4762a1bSJed Brown 49c4762a1bSJed Brown x = [3, 2, 1] 50*4d3610e3SJacob Faibussowitsch x1 = [3, 2, 1] 51c4762a1bSJed Brown y = [6, 5, 4] 52c4762a1bSJed Brown z = [3, 5, 2] 53c4762a1bSJed Brown mx = [five, seven, two] 54c4762a1bSJed Brown my = [five, seven, two] 55c4762a1bSJed Brown mz = [five, seven, two] 56c4762a1bSJed Brown s = [1.0, 2.0, 3.0] 57c4762a1bSJed Brown r = [1.0, 2.0, 3.0] 58*4d3610e3SJacob Faibussowitsch sizeofentry = sizeof(dummyint) 59*4d3610e3SJacob Faibussowitsch ctx%myint = 1 60c4762a1bSJed Brown call PetscSortInt(N,x,ierr) 61*4d3610e3SJacob Faibussowitsch call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr) 62*4d3610e3SJacob Faibussowitsch do i = 1,N 63*4d3610e3SJacob Faibussowitsch if (x1(i) .ne. x(i)) then 64*4d3610e3SJacob Faibussowitsch SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match") 65*4d3610e3SJacob Faibussowitsch end if 66*4d3610e3SJacob Faibussowitsch end do 67c4762a1bSJed Brown call PetscSortIntWithArray(N,y,x,ierr) 68c4762a1bSJed Brown call PetscSortIntWithArrayPair(N,x,y,z,ierr) 69c4762a1bSJed Brown 70c4762a1bSJed Brown call PetscSortMPIInt(N,mx,ierr) 71c4762a1bSJed Brown call PetscSortMPIIntWithArray(mN,mx,my,ierr) 72c4762a1bSJed Brown call PetscSortMPIIntWithIntArray(mN,mx,y,ierr) 73c4762a1bSJed Brown 74c4762a1bSJed Brown call PetscSortIntWithScalarArray(N,x,s,ierr) 75c4762a1bSJed Brown 76c4762a1bSJed Brown call PetscSortReal(N,r,ierr) 77c4762a1bSJed Brown call PetscSortRealWithArrayInt(N,r,x,ierr) 78c4762a1bSJed Brown 79c4762a1bSJed Brown call PetscFinalize(ierr) 80*4d3610e3SJacob Faibussowitschend program main 81c4762a1bSJed Brown 82c4762a1bSJed Brown!/*TEST 83c4762a1bSJed Brown! 84c4762a1bSJed Brown! test: 85c4762a1bSJed Brown! 86c4762a1bSJed Brown!TEST*/ 87