1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Test Fortran binding of sort routines 3c4762a1bSJed Brown! 44d3610e3SJacob Faibussowitschmodule UserContext 5c4762a1bSJed Brown use petsc 64d3610e3SJacob Faibussowitsch#include "petsc/finclude/petsc.h" 74d3610e3SJacob Faibussowitsch implicit none 84d3610e3SJacob Faibussowitsch type uctx 94d3610e3SJacob Faibussowitsch PetscInt myint 104d3610e3SJacob Faibussowitsch end type uctx 114d3610e3SJacob Faibussowitschcontains 124d3610e3SJacob Faibussowitsch subroutine CompareIntegers(a,b,ctx,res) 134d3610e3SJacob Faibussowitsch implicit none 144d3610e3SJacob Faibussowitsch 154d3610e3SJacob Faibussowitsch PetscInt :: a,b 164d3610e3SJacob Faibussowitsch type(uctx) :: ctx 174d3610e3SJacob Faibussowitsch integer :: res 184d3610e3SJacob Faibussowitsch 194d3610e3SJacob Faibussowitsch if (a < b) then 204d3610e3SJacob Faibussowitsch res = -1 214d3610e3SJacob Faibussowitsch else if (a == b) then 224d3610e3SJacob Faibussowitsch res = 0 234d3610e3SJacob Faibussowitsch else 244d3610e3SJacob Faibussowitsch res = 1 254d3610e3SJacob Faibussowitsch end if 264d3610e3SJacob Faibussowitsch return 274d3610e3SJacob Faibussowitsch end subroutine CompareIntegers 284d3610e3SJacob Faibussowitschend module UserContext 294d3610e3SJacob Faibussowitsch 304d3610e3SJacob Faibussowitschprogram main 314d3610e3SJacob Faibussowitsch 324d3610e3SJacob 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 384d3610e3SJacob 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 434d3610e3SJacob Faibussowitsch type(uctx):: ctx 44*2a27bf02SStefano Zampini PetscInt i 454d3610e3SJacob Faibussowitsch PetscSizeT sizeofentry 46c4762a1bSJed Brown 47c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 48c4762a1bSJed Brown 49c4762a1bSJed Brown x = [3, 2, 1] 504d3610e3SJacob 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] 584d3610e3SJacob Faibussowitsch sizeofentry = sizeof(dummyint) 594d3610e3SJacob Faibussowitsch ctx%myint = 1 60c4762a1bSJed Brown call PetscSortInt(N,x,ierr) 614d3610e3SJacob Faibussowitsch call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr) 624d3610e3SJacob Faibussowitsch do i = 1,N 634d3610e3SJacob Faibussowitsch if (x1(i) .ne. x(i)) then 644d3610e3SJacob Faibussowitsch SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match") 654d3610e3SJacob Faibussowitsch end if 664d3610e3SJacob 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) 804d3610e3SJacob Faibussowitschend program main 81c4762a1bSJed Brown 82c4762a1bSJed Brown!/*TEST 83c4762a1bSJed Brown! 84c4762a1bSJed Brown! test: 85c4762a1bSJed Brown! 86c4762a1bSJed Brown!TEST*/ 87