xref: /petsc/src/sys/tests/ex57.c (revision 2fa40bb9206b96114faa7cb222621ec184d31cd2)
1 static const char help[] = "Tests creation and destruction of PetscDeviceContext.\n\n";
2 
3 #include <petscdevice.h>
4 
5 /* test duplication creates the same object type */
6 static PetscErrorCode testDuplicate(PetscDeviceContext dctx)
7 {
8   PetscStreamType    stype,dupSType;
9   PetscDeviceContext dtmp,ddup;
10   PetscDevice        device,dupDevice;
11   PetscErrorCode     ierr;
12 
13   PetscFunctionBegin;
14   ierr = PetscDeviceContextGetStreamType(dctx,&stype);CHKERRQ(ierr);
15   ierr = PetscDeviceContextGetDevice(dctx,&device);CHKERRQ(ierr);
16 
17   /* create manually first */
18   ierr = PetscDeviceContextCreate(&dtmp);CHKERRQ(ierr);
19   ierr = PetscDeviceContextSetDevice(dtmp,device);CHKERRQ(ierr);
20   ierr = PetscDeviceContextSetStreamType(dtmp,stype);CHKERRQ(ierr);
21   ierr = PetscDeviceContextSetUp(dtmp);CHKERRQ(ierr);
22 
23   /* duplicate */
24   ierr = PetscDeviceContextDuplicate(dctx,&ddup);CHKERRQ(ierr);
25 
26   ierr = PetscDeviceContextGetDevice(ddup,&dupDevice);CHKERRQ(ierr);
27   ierr = PetscDeviceContextGetDevice(dtmp,&device);CHKERRQ(ierr);
28   if (device != dupDevice) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"PetscDeviceContextDevices do not match");
29 
30   ierr = PetscDeviceContextGetStreamType(ddup,&dupSType);CHKERRQ(ierr);
31   ierr = PetscDeviceContextGetStreamType(dtmp,&stype);CHKERRQ(ierr);
32   if (dupSType != stype) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscStreamTypes %d and %d do not match",dupSType,stype);
33 
34   ierr = PetscDeviceContextDestroy(&dtmp);CHKERRQ(ierr);
35   ierr = PetscDeviceContextDestroy(&ddup);CHKERRQ(ierr);
36   PetscFunctionReturn(0);
37 }
38 
39 static PetscErrorCode testNestedForkJoin(PetscDeviceContext *sub)
40 {
41   const PetscInt      nsub = 4;
42   PetscDeviceContext *subsub;
43   PetscDeviceContext  parCtx;
44   PetscErrorCode      ierr;
45 
46   PetscFunctionBegin;
47   ierr = PetscDeviceContextGetCurrentContext(&parCtx);CHKERRQ(ierr);
48   if (parCtx != sub[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Current global context does not match expected global context");
49   ierr = PetscDeviceContextFork(parCtx,nsub,&subsub);CHKERRQ(ierr);
50   /* join on a different sub */
51   ierr = PetscDeviceContextJoin(sub[1],nsub-2,PETSC_DEVICE_CONTEXT_JOIN_SYNC,&subsub);CHKERRQ(ierr);
52   ierr = PetscDeviceContextJoin(parCtx,nsub,PETSC_DEVICE_CONTEXT_JOIN_DESTROY,&subsub);CHKERRQ(ierr);
53   PetscFunctionReturn(0);
54 }
55 
56 /* test fork-join */
57 static PetscErrorCode testForkJoin(PetscDeviceContext dctx)
58 {
59   PetscDeviceContext *sub;
60   const PetscInt      n = 10;
61   PetscErrorCode      ierr;
62 
63   PetscFunctionBegin;
64   /* mostly for valgrind to catch errors */
65   ierr = PetscDeviceContextFork(dctx,n,&sub);CHKERRQ(ierr);
66   ierr = PetscDeviceContextJoin(dctx,n,PETSC_DEVICE_CONTEXT_JOIN_DESTROY,&sub);CHKERRQ(ierr);
67 
68   /* create some children */
69   ierr = PetscDeviceContextFork(dctx,n+1,&sub);CHKERRQ(ierr);
70 
71   /* make the first child the new current context, and test forking within nested function */
72   ierr = PetscDeviceContextSetCurrentContext(sub[0]);CHKERRQ(ierr);
73   ierr = testNestedForkJoin(sub);CHKERRQ(ierr);
74   /* should always reset global context when finished */
75   ierr = PetscDeviceContextSetCurrentContext(dctx);CHKERRQ(ierr);
76 
77   /* join a subset */
78   ierr = PetscDeviceContextJoin(dctx,n-1,PETSC_DEVICE_CONTEXT_JOIN_NO_SYNC,&sub);CHKERRQ(ierr);
79   /* back to the ether from whence they came */
80   ierr = PetscDeviceContextJoin(dctx,n+1,PETSC_DEVICE_CONTEXT_JOIN_DESTROY,&sub);CHKERRQ(ierr);
81   PetscFunctionReturn(0);
82 }
83 
84 int main(int argc, char *argv[])
85 {
86   PetscDeviceContext dctx;
87   PetscErrorCode     ierr;
88 
89   ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
90 
91   /* Initialize the root */
92   ierr = PetscDeviceContextGetCurrentContext(&dctx);CHKERRQ(ierr);
93 
94   /* tests */
95   ierr = testDuplicate(dctx);CHKERRQ(ierr);
96   ierr = testForkJoin(dctx);CHKERRQ(ierr);
97 
98   ierr = PetscPrintf(PETSC_COMM_WORLD,"EXIT_SUCCESS\n");CHKERRQ(ierr);
99   ierr = PetscFinalize();
100   return ierr;
101 }
102 
103 /*TEST
104 
105   build:
106     requires: defined(PETSC_HAVE_CXX_DIALECT_CXX11) && defined(PETSC_EXPERIMENTAL)
107 
108   test:
109     requires: cuda
110     suffix: cuda
111 
112   test:
113     requires: hip
114     suffix: hip
115 TEST*/
116