xref: /petsc/src/sys/tests/ex49f.F90 (revision ccfd86f17c20321558100f6af55b03dc7cd752d2)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Test Fortran binding of sort routines
3c4762a1bSJed Brown!
477d968b7SBarry Smithmodule ex49fmodule
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  end subroutine CompareIntegers
2777d968b7SBarry Smithend module ex49fmodule
284d3610e3SJacob Faibussowitsch
294d3610e3SJacob Faibussowitschprogram main
304d3610e3SJacob Faibussowitsch
3177d968b7SBarry Smith  use ex49fmodule
32c4762a1bSJed Brown  implicit none
33c4762a1bSJed Brown
34c4762a1bSJed Brown  PetscErrorCode          ierr
356497c311SBarry Smith  PetscCount,parameter::  iN = 3
36c4762a1bSJed Brown  PetscInt, parameter ::  N = 3
374d3610e3SJacob Faibussowitsch  PetscInt                x(N),x1(N),y(N),z(N)
38d2c61337SStefano Zampini  PetscMPIInt             mx(N),my(N)
39c4762a1bSJed Brown  PetscScalar             s(N)
40c4762a1bSJed Brown  PetscReal               r(N)
41c4762a1bSJed Brown  PetscMPIInt,parameter:: two=2, five=5, seven=7
424d3610e3SJacob Faibussowitsch  type(uctx)::            ctx
432a27bf02SStefano Zampini  PetscInt                i
444d3610e3SJacob Faibussowitsch  PetscSizeT              sizeofentry
45c4762a1bSJed Brown
46d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
47c4762a1bSJed Brown
48c4762a1bSJed Brown  x  = [3, 2, 1]
494d3610e3SJacob Faibussowitsch  x1 = [3, 2, 1]
50c4762a1bSJed Brown  y  = [6, 5, 4]
51c4762a1bSJed Brown  z  = [3, 5, 2]
52c4762a1bSJed Brown  mx = [five, seven, two]
53c4762a1bSJed Brown  my = [five, seven, two]
54c4762a1bSJed Brown  s  = [1.0, 2.0, 3.0]
55c4762a1bSJed Brown  r  = [1.0, 2.0, 3.0]
56d2c61337SStefano Zampini#if defined(PETSC_USE_64BIT_INDICES)
57*ccfd86f1SBarry Smith  sizeofentry = 8
58d2c61337SStefano Zampini#else
59*ccfd86f1SBarry Smith  sizeofentry = 4
60d2c61337SStefano Zampini#endif
614d3610e3SJacob Faibussowitsch  ctx%myint = 1
626497c311SBarry Smith  PetscCallA(PetscSortInt(iN,x,ierr))
63f8402805SBarry Smith  PetscCallA(PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr))
644d3610e3SJacob Faibussowitsch  do i = 1,N
65dcb3e689SBarry Smith    PetscCheckA(x1(i) .eq. x(i),PETSC_COMM_SELF,PETSC_ERR_PLIB,'PetscTimSort and PetscSortInt arrays did not match')
664d3610e3SJacob Faibussowitsch  end do
676497c311SBarry Smith  PetscCallA(PetscSortIntWithArray(iN,y,x,ierr))
686497c311SBarry Smith  PetscCallA(PetscSortIntWithArrayPair(iN,x,y,z,ierr))
69c4762a1bSJed Brown
706497c311SBarry Smith  PetscCallA(PetscSortMPIInt(iN,mx,ierr))
716497c311SBarry Smith  PetscCallA(PetscSortMPIIntWithArray(iN,mx,my,ierr))
726497c311SBarry Smith  PetscCallA(PetscSortMPIIntWithIntArray(iN,mx,y,ierr))
73c4762a1bSJed Brown
746497c311SBarry Smith  PetscCallA(PetscSortIntWithScalarArray(iN,x,s,ierr))
75c4762a1bSJed Brown
766497c311SBarry Smith  PetscCallA(PetscSortReal(iN,r,ierr))
776497c311SBarry Smith  PetscCallA(PetscSortRealWithArrayInt(iN,r,x,ierr))
78c4762a1bSJed Brown
79f8402805SBarry Smith  PetscCallA(PetscFinalize(ierr))
804d3610e3SJacob Faibussowitschend program main
81c4762a1bSJed Brown
82c4762a1bSJed Brown!/*TEST
83c4762a1bSJed Brown!
84c4762a1bSJed Brown!   test:
85c4762a1bSJed Brown!
86c4762a1bSJed Brown!TEST*/
87