Actual source code: ex49f.F90
1: !
2: ! Test Fortran binding of sort routines
3: !
4: module ex49fmodule
5: use petsc
6: #include "petsc/finclude/petsc.h"
7: implicit none
8: type uctx
9: PetscInt myint
10: end type uctx
11: contains
12: subroutine CompareIntegers(a,b,ctx,res)
13: implicit none
15: PetscInt :: a,b
16: type(uctx) :: ctx
17: integer :: res
19: if (a < b) then
20: res = -1
21: else if (a == b) then
22: res = 0
23: else
24: res = 1
25: end if
26: return
27: end subroutine CompareIntegers
28: end module ex49fmodule
30: program main
32: use ex49fmodule
33: implicit none
35: PetscErrorCode ierr
36: PetscInt,parameter:: N=3
37: PetscMPIInt,parameter:: mN=3
38: PetscInt x(N),x1(N),y(N),z(N)
39: PetscMPIInt mx(N),my(N)
40: PetscScalar s(N)
41: PetscReal r(N)
42: PetscMPIInt,parameter:: two=2, five=5, seven=7
43: type(uctx):: ctx
44: PetscInt i
45: PetscSizeT sizeofentry
47: PetscCallA(PetscInitialize(ierr))
49: x = [3, 2, 1]
50: x1 = [3, 2, 1]
51: y = [6, 5, 4]
52: z = [3, 5, 2]
53: mx = [five, seven, two]
54: my = [five, seven, two]
55: s = [1.0, 2.0, 3.0]
56: r = [1.0, 2.0, 3.0]
57: #if defined(PETSC_USE_64BIT_INDICES)
58: sizeofentry = 8;
59: #else
60: sizeofentry = 4;
61: #endif
62: ctx%myint = 1
63: PetscCallA(PetscSortInt(N,x,ierr))
64: PetscCallA(PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr))
65: do i = 1,N
66: PetscCheckA(x1(i) .eq. x(i),PETSC_COMM_SELF,PETSC_ERR_PLIB,'PetscTimSort and PetscSortInt arrays did not match')
67: end do
68: PetscCallA(PetscSortIntWithArray(N,y,x,ierr))
69: PetscCallA(PetscSortIntWithArrayPair(N,x,y,z,ierr))
71: PetscCallA(PetscSortMPIInt(N,mx,ierr))
72: PetscCallA(PetscSortMPIIntWithArray(mN,mx,my,ierr))
73: PetscCallA(PetscSortMPIIntWithIntArray(mN,mx,y,ierr))
75: PetscCallA(PetscSortIntWithScalarArray(N,x,s,ierr))
77: PetscCallA(PetscSortReal(N,r,ierr))
78: PetscCallA(PetscSortRealWithArrayInt(N,r,x,ierr))
80: PetscCallA(PetscFinalize(ierr))
81: end program main
83: !/*TEST
84: !
85: ! test:
86: !
87: !TEST*/