Actual source code: ex49f.F90
1: !
2: ! Test Fortran binding of sort routines
3: !
4: module UserContext
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 UserContext
30: program main
32: use UserContext
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),mz(N)
40: PetscScalar s(N)
41: PetscReal r(N)
42: PetscMPIInt,parameter:: two=2, five=5, seven=7
43: type(uctx):: ctx
44: PetscInt dummyint, i
45: PetscSizeT sizeofentry
47: call PetscInitialize(PETSC_NULL_CHARACTER,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: mz = [five, seven, two]
56: s = [1.0, 2.0, 3.0]
57: r = [1.0, 2.0, 3.0]
58: sizeofentry = sizeof(dummyint)
59: ctx%myint = 1
60: call PetscSortInt(N,x,ierr)
61: call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr)
62: do i = 1,N
63: if (x1(i) .ne. x(i)) then
64: SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match")
65: end if
66: end do
67: call PetscSortIntWithArray(N,y,x,ierr)
68: call PetscSortIntWithArrayPair(N,x,y,z,ierr)
70: call PetscSortMPIInt(N,mx,ierr)
71: call PetscSortMPIIntWithArray(mN,mx,my,ierr)
72: call PetscSortMPIIntWithIntArray(mN,mx,y,ierr)
74: call PetscSortIntWithScalarArray(N,x,s,ierr)
76: call PetscSortReal(N,r,ierr)
77: call PetscSortRealWithArrayInt(N,r,x,ierr)
79: call PetscFinalize(ierr)
80: end program main
82: !/*TEST
83: !
84: ! test:
85: !
86: !TEST*/