xref: /petsc/src/sys/tests/ex49f.F90 (revision 9b88ac225e01f016352a5f4cd90e158abe5f5675)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Test Fortran binding of sort routines
3c4762a1bSJed Brown!
4*c5e229c2SMartin Diehl#include "petsc/finclude/petsc.h"
577d968b7SBarry Smithmodule ex49fmodule
6c4762a1bSJed Brown  use petsc
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)
57ccfd86f1SBarry Smith  sizeofentry = 8
58d2c61337SStefano Zampini#else
59ccfd86f1SBarry 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
654820e4eaSBarry Smith    PetscCheckA(x1(i) == 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:
853886731fSPierre Jolivet!      output_file: output/empty.out
86c4762a1bSJed Brown!
87c4762a1bSJed Brown!TEST*/
88