xref: /petsc/src/sys/tests/ex49f.F90 (revision dcb3e68992f1c4897946af7e8406e2b4165e50f2)
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    return
274d3610e3SJacob Faibussowitsch  end subroutine CompareIntegers
2877d968b7SBarry Smithend module ex49fmodule
294d3610e3SJacob Faibussowitsch
304d3610e3SJacob Faibussowitschprogram main
314d3610e3SJacob Faibussowitsch
3277d968b7SBarry Smith  use ex49fmodule
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)
39d2c61337SStefano Zampini  PetscMPIInt             mx(N),my(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
442a27bf02SStefano Zampini  PetscInt                i
454d3610e3SJacob Faibussowitsch  PetscSizeT              sizeofentry
46c4762a1bSJed Brown
47d8606c27SBarry Smith  PetscCallA(PetscInitialize(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  s  = [1.0, 2.0, 3.0]
56c4762a1bSJed Brown  r  = [1.0, 2.0, 3.0]
57d2c61337SStefano Zampini#if defined(PETSC_USE_64BIT_INDICES)
58d2c61337SStefano Zampini  sizeofentry = 8;
59d2c61337SStefano Zampini#else
60d2c61337SStefano Zampini  sizeofentry = 4;
61d2c61337SStefano Zampini#endif
624d3610e3SJacob Faibussowitsch  ctx%myint = 1
63f8402805SBarry Smith  PetscCallA(PetscSortInt(N,x,ierr))
64f8402805SBarry Smith  PetscCallA(PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr))
654d3610e3SJacob Faibussowitsch  do i = 1,N
66*dcb3e689SBarry Smith    PetscCheckA(x1(i) .eq. x(i),PETSC_COMM_SELF,PETSC_ERR_PLIB,'PetscTimSort and PetscSortInt arrays did not match')
674d3610e3SJacob Faibussowitsch  end do
68f8402805SBarry Smith  PetscCallA(PetscSortIntWithArray(N,y,x,ierr))
69f8402805SBarry Smith  PetscCallA(PetscSortIntWithArrayPair(N,x,y,z,ierr))
70c4762a1bSJed Brown
71f8402805SBarry Smith  PetscCallA(PetscSortMPIInt(N,mx,ierr))
72f8402805SBarry Smith  PetscCallA(PetscSortMPIIntWithArray(mN,mx,my,ierr))
73f8402805SBarry Smith  PetscCallA(PetscSortMPIIntWithIntArray(mN,mx,y,ierr))
74c4762a1bSJed Brown
75f8402805SBarry Smith  PetscCallA(PetscSortIntWithScalarArray(N,x,s,ierr))
76c4762a1bSJed Brown
77f8402805SBarry Smith  PetscCallA(PetscSortReal(N,r,ierr))
78f8402805SBarry Smith  PetscCallA(PetscSortRealWithArrayInt(N,r,x,ierr))
79c4762a1bSJed Brown
80f8402805SBarry Smith  PetscCallA(PetscFinalize(ierr))
814d3610e3SJacob Faibussowitschend program main
82c4762a1bSJed Brown
83c4762a1bSJed Brown!/*TEST
84c4762a1bSJed Brown!
85c4762a1bSJed Brown!   test:
86c4762a1bSJed Brown!
87c4762a1bSJed Brown!TEST*/
88