Actual source code: tagm.c
1: #define PETSC_DLL
2: /*
3: Some PETSc utilites
4: */
5: #include petscsys.h
6: #if defined(PETSC_HAVE_STDLIB_H)
7: #include <stdlib.h>
8: #endif
10: /* ---------------------------------------------------------------- */
11: /*
12: A simple way to manage tags inside a communicator.
14: It uses the attributes to determine if a new communicator
15: is needed and to store the available tags.
17: */
22: /*@C
23: PetscObjectGetNewTag - Gets a unique new tag from a PETSc object. All
24: processors that share the object MUST call this routine EXACTLY the same
25: number of times. This tag should only be used with the current objects
26: communicator; do NOT use it with any other MPI communicator.
28: Collective on PetscObject
30: Input Parameter:
31: . obj - the PETSc object; this must be cast with a (PetscObject), for example,
32: PetscObjectGetNewTag((PetscObject)mat,&tag);
34: Output Parameter:
35: . tag - the new tag
37: Level: developer
39: Concepts: tag^getting
40: Concepts: message tag^getting
41: Concepts: MPI message tag^getting
43: .seealso: PetscCommGetNewTag()
44: @*/
45: PetscErrorCode PetscObjectGetNewTag(PetscObject obj,PetscMPIInt *tag)
46: {
50: PetscCommGetNewTag(obj->comm,tag);
51: return(0);
52: }
56: /*@
57: PetscCommGetNewTag - Gets a unique new tag from a PETSc communicator. All
58: processors that share the communicator MUST call this routine EXACTLY the same
59: number of times. This tag should only be used with the current objects
60: communicator; do NOT use it with any other MPI communicator.
62: Collective on comm
64: Input Parameter:
65: . comm - the MPI communicator
67: Output Parameter:
68: . tag - the new tag
70: Level: developer
72: Concepts: tag^getting
73: Concepts: message tag^getting
74: Concepts: MPI message tag^getting
76: .seealso: PetscObjectGetNewTag(), PetscCommDuplicate()
77: @*/
78: PetscErrorCode PetscCommGetNewTag(MPI_Comm comm,PetscMPIInt *tag)
79: {
80: PetscErrorCode ierr;
81: PetscCommCounter *counter;
82: PetscMPIInt *maxval,flg;
87: MPI_Attr_get(comm,Petsc_Counter_keyval,&counter,&flg);
88: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator");
90: if (counter->tag < 1) {
91: PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",counter->refcount);
92: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);
93: if (!flg) {
94: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
95: }
96: counter->tag = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
97: }
99: *tag = counter->tag--;
100: #if defined(PETSC_USE_DEBUG)
101: /*
102: Hanging here means that some processes have called PetscCommGetNewTag() and others have not.
103: */
104: MPI_Barrier(comm);
105: #endif
106: return(0);
107: }
111: /*@C
112: PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc communicator.
114: Collective on MPI_Comm
116: Input Parameters:
117: . comm_in - Input communicator
119: Output Parameters:
120: + comm_out - Output communicator. May be comm_in.
121: - first_tag - Tag available that has not already been used with this communicator (you may
122: pass in PETSC_NULL if you do not need a tag)
124: PETSc communicators are just regular MPI communicators that keep track of which
125: tags have been used to prevent tag conflict. If you pass a non-PETSc communicator into
126: a PETSc creation routine it will attach a private communicator for use in the objects communications.
127: The internal MPI_Comm is used to perform all the MPI calls for PETSc, the outter MPI_Comm is a user
128: level MPI_Comm that may be performing communication for the user or other library and so IS NOT used by PETSc.
130: Level: developer
132: Concepts: communicator^duplicate
134: .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag(), PetscCommDestroy()
135: @*/
136: PetscErrorCode PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,PetscMPIInt* first_tag)
137: {
138: PetscErrorCode ierr;
139: PetscCommCounter *counter;
140: PetscMPIInt *maxval,flg;
143: MPI_Attr_get(comm_in,Petsc_Counter_keyval,&counter,&flg);
145: if (!flg) { /* this is NOT a PETSc comm */
146: void *ptr;
147: /* check if this communicator has a PETSc communicator imbedded in it */
148: MPI_Attr_get(comm_in,Petsc_InnerComm_keyval,&ptr,&flg);
149: if (!flg) {
150: /* This communicator is not yet known to this system, so we duplicate it and make an internal communicator */
151: MPI_Comm_dup(comm_in,comm_out);
152: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);
153: if (!flg) {
154: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
155: }
156: PetscMalloc(sizeof(PetscCommCounter),&counter);
157: counter->tag = *maxval;
158: counter->refcount = 0;
159: counter->namecount = 0;
160: MPI_Attr_put(*comm_out,Petsc_Counter_keyval,counter);
161: PetscInfo3(0,"Duplicating a communicator %ld %ld max tags = %d\n",(long)comm_in,(long)*comm_out,*maxval);
163: /* save PETSc communicator inside user communicator, so we can get it next time */
164: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
165: PetscMemcpy(&ptr,comm_out,sizeof(MPI_Comm));
166: MPI_Attr_put(comm_in,Petsc_InnerComm_keyval,ptr);
167: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
168: PetscMemcpy(&ptr,&comm_in,sizeof(MPI_Comm));
169: MPI_Attr_put(*comm_out,Petsc_OuterComm_keyval,ptr);
170: } else {
171: /* pull out the inner MPI_Comm and hand it back to the caller */
172: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
173: PetscMemcpy(comm_out,&ptr,sizeof(MPI_Comm));
174: MPI_Attr_get(*comm_out,Petsc_Counter_keyval,&counter,&flg);
175: if (!flg) {
176: SETERRQ(PETSC_ERR_PLIB,"Inner PETSc communicator does not have its tag/name counter attribute set");
177: }
178: PetscInfo2(0,"Using internal PETSc communicator %ld %ld\n",(long)comm_in,(long)*comm_out);
179: }
180: } else {
181: *comm_out = comm_in;
182: }
184: #if defined(PETSC_USE_DEBUG)
185: /*
186: Hanging here means that some processes have called PetscCommDuplicate() and others have not.
187: This likley means that a subset of processes in a MPI_Comm have attempted to create a PetscObject!
188: ALL processes that share a communicator MUST shared objects created from that communicator.
189: */
190: MPI_Barrier(comm_in);
191: #endif
193: if (counter->tag < 1) {
194: PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",counter->refcount);
195: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);
196: if (!flg) {
197: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
198: }
199: counter->tag = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
200: }
202: if (first_tag) {
203: *first_tag = counter->tag--;
204: PetscInfo1(0," returning tag %ld\n",(long)*first_tag);
205: }
206: counter->refcount++; /* number of references to this comm */
207: return(0);
208: }
212: /*@C
213: PetscCommDestroy - Frees communicator. Use in conjunction with PetscCommDuplicate().
215: Collective on MPI_Comm
217: Input Parameter:
218: . comm - the communicator to free
220: Level: developer
222: Concepts: communicator^destroy
224: .seealso: PetscCommDuplicate()
225: @*/
226: PetscErrorCode PetscCommDestroy(MPI_Comm *comm)
227: {
228: PetscErrorCode ierr;
229: PetscCommCounter *counter;
230: PetscMPIInt flg;
231: MPI_Comm icomm = *comm,ocomm;
232: void *ptr;
235: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
236: if (!flg) { /* not a PETSc comm, check if it has an inner comm */
237: MPI_Attr_get(icomm,Petsc_InnerComm_keyval,&ptr,&flg);
238: if (!flg) {
239: SETERRQ(PETSC_ERR_ARG_CORRUPT,"MPI_Comm does not have tag/name counter nor does it have inner MPI_Comm");
240: }
241: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
242: PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));
243: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
244: if (!flg) {
245: SETERRQ(PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
246: }
247: }
248: counter->refcount--;
249: if (!counter->refcount) {
251: /* if MPI_Comm has outter comm then remove reference to inner MPI_Comm from outter MPI_Comm */
252: MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,&flg);
253: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
254: PetscMemcpy(&ocomm,&ptr,sizeof(MPI_Comm));
255: if (flg) {
256: MPI_Attr_delete(ocomm,Petsc_InnerComm_keyval);
257: }
259: PetscInfo1(0,"Deleting PETSc MPI_Comm %ld\n",(long)icomm);
260: MPI_Comm_free(&icomm);
261: }
262: return(0);
263: }