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: Notes on the implementation
19: The tagvalues to use are stored in a two element array. The first element
20: is the first free tag value. The second is used to indicate how
21: many references of the communicator there, when it equals zero the communicator may be freed.
23:
24: */
26: static PetscMPIInt Petsc_Tag_keyval = MPI_KEYVAL_INVALID;
27: static PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID;
28: static PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID;
32: /*
33: Private routine to delete internal tag storage when a communicator is freed.
35: This is called by MPI, not by users.
39: */
40: PetscMPIInt Petsc_DelTag(MPI_Comm comm,PetscMPIInt keyval,void* attr_val,void* extra_state)
41: {
45: PetscInfo1(0,"Deleting tag data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
46: PetscFree(attr_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
47: PetscFunctionReturn(MPI_SUCCESS);
48: }
54: /*
55: This does not actually free anything, it simply marks when a reference count to an internal MPI_Comm reaches zero and the
56: the external MPI_Comm drops its reference to the internal MPI_Comm
58: This is called by MPI, not by users.
62: */
63: PetscMPIInt Petsc_DelComm(MPI_Comm comm,PetscMPIInt keyval,void* attr_val,void* extra_state)
64: {
68: PetscInfo1(0,"Deleting PETSc communicator imbedded in a user MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
69: /* actually don't delete anything because we cannot increase the reference count of the communicator anyways */
70: PetscFunctionReturn(MPI_SUCCESS);
71: }
76: /*@C
77: PetscObjectGetNewTag - Gets a unique new tag from a PETSc object. All
78: processors that share the object MUST call this routine EXACTLY the same
79: number of times. This tag should only be used with the current objects
80: communicator; do NOT use it with any other MPI communicator.
82: Collective on PetscObject
84: Input Parameter:
85: . obj - the PETSc object; this must be cast with a (PetscObject), for example,
86: PetscObjectGetNewTag((PetscObject)mat,&tag);
88: Output Parameter:
89: . tag - the new tag
91: Level: developer
93: Concepts: tag^getting
94: Concepts: message tag^getting
95: Concepts: MPI message tag^getting
97: .seealso: PetscCommGetNewTag()
98: @*/
99: PetscErrorCode PetscObjectGetNewTag(PetscObject obj,PetscMPIInt *tag)
100: {
104: PetscCommGetNewTag(obj->comm,tag);
105: return(0);
106: }
110: /*@
111: PetscCommGetNewTag - Gets a unique new tag from a PETSc communicator. All
112: processors that share the communicator MUST call this routine EXACTLY the same
113: number of times. This tag should only be used with the current objects
114: communicator; do NOT use it with any other MPI communicator.
116: Collective on comm
118: Input Parameter:
119: . comm - the MPI communicator
121: Output Parameter:
122: . tag - the new tag
124: Level: developer
126: Concepts: tag^getting
127: Concepts: message tag^getting
128: Concepts: MPI message tag^getting
130: .seealso: PetscObjectGetNewTag(), PetscCommDuplicate()
131: @*/
132: PetscErrorCode PetscCommGetNewTag(MPI_Comm comm,PetscMPIInt *tag)
133: {
135: PetscMPIInt *tagvalp=0,*maxval;
136: PetscTruth flg;
141: if (Petsc_Tag_keyval == MPI_KEYVAL_INVALID) {
142: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tag_keyval,(void*)0);
143: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);
144: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);
145: }
147: MPI_Attr_get(comm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
148: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator");
150: if (tagvalp[0] < 1) {
151: PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",tagvalp[1]);
152: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
153: if (!flg) {
154: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
155: }
156: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
157: }
159: *tag = tagvalp[0]--;
160: #if defined(PETSC_USE_DEBUG)
161: /*
162: Hanging here means that some processes have called PetscCommGetNewTag() and others have not.
163: */
164: MPI_Barrier(comm);
165: #endif
166: return(0);
167: }
171: /*@C
172: PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc communicator.
174: Collective on MPI_Comm
176: Input Parameters:
177: . comm_in - Input communicator
179: Output Parameters:
180: + comm_out - Output communicator. May be comm_in.
181: - first_tag - Tag available that has not already been used with this communicator (you may
182: pass in PETSC_NULL if you do not need a tag)
184: PETSc communicators are just regular MPI communicators that keep track of which
185: tags have been used to prevent tag conflict. If you pass a non-PETSc communicator into
186: a PETSc creation routine it will attach a private communicator for use in the objects communications.
187: The internal MPI_Comm is used to perform all the MPI calls for PETSc, the outter MPI_Comm is a user
188: level MPI_Comm that may be performing communication for the user or other library and so IS NOT used by PETSc.
190: Level: developer
192: Concepts: communicator^duplicate
194: .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag()
195: @*/
196: PetscErrorCode PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,PetscMPIInt* first_tag)
197: {
199: PetscMPIInt *tagvalp,*maxval;
200: PetscTruth flg;
203: if (Petsc_Tag_keyval == MPI_KEYVAL_INVALID) {
204: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tag_keyval,(void*)0);
205: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);
206: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);
207: }
208: MPI_Attr_get(comm_in,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
210: if (!flg) { /* this is NOT a PETSc comm */
211: void *ptr;
212: /* check if this communicator has a PETSc communicator imbedded in it */
213: MPI_Attr_get(comm_in,Petsc_InnerComm_keyval,&ptr,(PetscMPIInt*)&flg);
214: if (!flg) {
215: /* This communicator is not yet known to this system, so we duplicate it and make an internal communicator */
216: MPI_Comm_dup(comm_in,comm_out);
217: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
218: if (!flg) {
219: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
220: }
221: PetscMalloc(2*sizeof(PetscMPIInt),&tagvalp);
222: tagvalp[0] = *maxval;
223: tagvalp[1] = 0;
224: MPI_Attr_put(*comm_out,Petsc_Tag_keyval,tagvalp);
225: PetscInfo3(0,"Duplicating a communicator %ld %ld max tags = %d\n",(long)comm_in,(long)*comm_out,*maxval);
227: /* save PETSc communicator inside user communicator, so we can get it next time */
228: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
229: PetscMemcpy(&ptr,comm_out,sizeof(MPI_Comm));
230: MPI_Attr_put(comm_in,Petsc_InnerComm_keyval,ptr);
231: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
232: PetscMemcpy(&ptr,&comm_in,sizeof(MPI_Comm));
233: MPI_Attr_put(*comm_out,Petsc_OuterComm_keyval,ptr);
234: } else {
235: /* pull out the inner MPI_Comm and hand it back to the caller */
236: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
237: PetscMemcpy(comm_out,&ptr,sizeof(MPI_Comm));
238: MPI_Attr_get(*comm_out,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
239: if (!flg) {
240: SETERRQ(PETSC_ERR_PLIB,"Inner PETSc communicator does not have its tagvalp attribute set");
241: }
242: PetscInfo2(0,"Using internal PETSc communicator %ld %ld\n",(long)comm_in,(long)*comm_out);
243: }
244: } else {
245: *comm_out = comm_in;
246: }
248: #if defined(PETSC_USE_DEBUG)
249: /*
250: Hanging here means that some processes have called PetscCommDuplicate() and others have not.
251: This likley means that a subset of processes in a MPI_Comm have attempted to create a PetscObject!
252: ALL processes that share a communicator MUST shared objects created from that communicator.
253: */
254: MPI_Barrier(comm_in);
255: #endif
257: if (tagvalp[0] < 1) {
258: PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",tagvalp[1]);
259: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
260: if (!flg) {
261: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
262: }
263: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
264: }
266: if (first_tag) {
267: *first_tag = tagvalp[0]--;
268: PetscInfo1(0," returning tag %ld\n",(long)*first_tag);
269: }
270: tagvalp[1]++; /* number of references to this comm */
271: return(0);
272: }
276: /*@C
277: PetscCommDestroy - Frees communicator. Use in conjunction with PetscCommDuplicate().
279: Collective on MPI_Comm
281: Input Parameter:
282: . comm - the communicator to free
284: Level: developer
286: Concepts: communicator^destroy
288: @*/
289: PetscErrorCode PetscCommDestroy(MPI_Comm *comm)
290: {
292: PetscMPIInt *tagvalp;
293: PetscTruth flg;
294: MPI_Comm icomm = *comm,ocomm;
295: void *ptr;
298: if (Petsc_Tag_keyval == MPI_KEYVAL_INVALID) {
299: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tag_keyval,(void*)0);
300: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);
301: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);
302: }
303: MPI_Attr_get(icomm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
304: if (!flg) { /* not a PETSc comm, check if it has an inner comm */
305: MPI_Attr_get(icomm,Petsc_InnerComm_keyval,&ptr,(PetscMPIInt*)&flg);
306: if (!flg) {
307: SETERRQ(PETSC_ERR_ARG_CORRUPT,"MPI_Comm does not have tagvalues nor does it have inner MPI_Comm");
308: }
309: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
310: PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));
311: MPI_Attr_get(icomm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
312: if (!flg) {
313: SETERRQ(PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tagvalues, problem with corrupted memory");
314: }
315: }
316: tagvalp[1]--;
317: if (!tagvalp[1]) {
319: /* if MPI_Comm has outter comm then remove reference to inner MPI_Comm from outter MPI_Comm */
320: MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,(PetscMPIInt*)&flg);
321: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
322: PetscMemcpy(&ocomm,&ptr,sizeof(MPI_Comm));
323: if (flg) {
324: MPI_Attr_delete(ocomm,Petsc_InnerComm_keyval);
325: }
327: PetscInfo1(0,"Deleting PETSc MPI_Comm %ld\n",(long)icomm);
328: MPI_Comm_free(&icomm);
329: }
330: return(0);
331: }