Actual source code: tagm.c
2: /*
3: Some PETSc utilites
4: */
5: #include <petscsys.h> /*I "petscsys.h" I*/
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_COMM_SELF,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) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
94: counter->tag = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
95: }
97: *tag = counter->tag--;
98: #if defined(PETSC_USE_DEBUG)
99: /*
100: Hanging here means that some processes have called PetscCommGetNewTag() and others have not.
101: */
102: MPI_Barrier(comm);
103: #endif
104: return(0);
105: }
109: /*@C
110: PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc communicator.
112: Collective on MPI_Comm
114: Input Parameters:
115: . comm_in - Input communicator
117: Output Parameters:
118: + comm_out - Output communicator. May be comm_in.
119: - first_tag - Tag available that has not already been used with this communicator (you may
120: pass in PETSC_NULL if you do not need a tag)
122: PETSc communicators are just regular MPI communicators that keep track of which
123: tags have been used to prevent tag conflict. If you pass a non-PETSc communicator into
124: a PETSc creation routine it will attach a private communicator for use in the objects communications.
125: The internal MPI_Comm is used to perform all the MPI calls for PETSc, the outer MPI_Comm is a user
126: level MPI_Comm that may be performing communication for the user or other library and so IS NOT used by PETSc.
128: Level: developer
130: Concepts: communicator^duplicate
132: .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag(), PetscCommDestroy()
133: @*/
134: PetscErrorCode PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,PetscMPIInt* first_tag)
135: {
136: PetscErrorCode ierr;
137: PetscCommCounter *counter;
138: PetscMPIInt *maxval,flg;
141: MPI_Attr_get(comm_in,Petsc_Counter_keyval,&counter,&flg);
143: if (!flg) { /* this is NOT a PETSc comm */
144: void *ptr;
145: /* check if this communicator has a PETSc communicator imbedded in it */
146: MPI_Attr_get(comm_in,Petsc_InnerComm_keyval,&ptr,&flg);
147: if (!flg) {
148: /* This communicator is not yet known to this system, so we duplicate it and make an internal communicator */
149: MPI_Comm_dup(comm_in,comm_out);
150: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);
151: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
152: PetscMalloc(sizeof(PetscCommCounter),&counter);
153: counter->tag = *maxval;
154: counter->refcount = 0;
155: counter->namecount = 0;
156: MPI_Attr_put(*comm_out,Petsc_Counter_keyval,counter);
157: PetscInfo3(0,"Duplicating a communicator %ld %ld max tags = %d\n",(long)comm_in,(long)*comm_out,*maxval);
159: /* save PETSc communicator inside user communicator, so we can get it next time */
160: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
161: PetscMemcpy(&ptr,comm_out,sizeof(MPI_Comm));
162: MPI_Attr_put(comm_in,Petsc_InnerComm_keyval,ptr);
163: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
164: PetscMemcpy(&ptr,&comm_in,sizeof(MPI_Comm));
165: MPI_Attr_put(*comm_out,Petsc_OuterComm_keyval,ptr);
166: } else {
167: /* pull out the inner MPI_Comm and hand it back to the caller */
168: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
169: PetscMemcpy(comm_out,&ptr,sizeof(MPI_Comm));
170: MPI_Attr_get(*comm_out,Petsc_Counter_keyval,&counter,&flg);
171: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Inner PETSc communicator does not have its tag/name counter attribute set");
172: PetscInfo2(0,"Using internal PETSc communicator %ld %ld\n",(long)comm_in,(long)*comm_out);
173: }
174: } else {
175: *comm_out = comm_in;
176: }
178: #if defined(PETSC_USE_DEBUG)
179: /*
180: Hanging here means that some processes have called PetscCommDuplicate() and others have not.
181: This likley means that a subset of processes in a MPI_Comm have attempted to create a PetscObject!
182: ALL processes that share a communicator MUST shared objects created from that communicator.
183: */
184: MPI_Barrier(comm_in);
185: #endif
187: if (counter->tag < 1) {
188: PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",counter->refcount);
189: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);
190: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
191: counter->tag = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
192: }
194: if (first_tag) {
195: *first_tag = counter->tag--;
196: }
197: counter->refcount++; /* number of references to this comm */
198: return(0);
199: }
203: /*@C
204: PetscCommDestroy - Frees communicator. Use in conjunction with PetscCommDuplicate().
206: Collective on MPI_Comm
208: Input Parameter:
209: . comm - the communicator to free
211: Level: developer
213: Concepts: communicator^destroy
215: .seealso: PetscCommDuplicate()
216: @*/
217: PetscErrorCode PetscCommDestroy(MPI_Comm *comm)
218: {
219: PetscErrorCode ierr;
220: PetscCommCounter *counter;
221: PetscMPIInt flg;
222: MPI_Comm icomm = *comm,ocomm;
223: void *ptr;
226: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
227: if (!flg) { /* not a PETSc comm, check if it has an inner comm */
228: MPI_Attr_get(icomm,Petsc_InnerComm_keyval,&ptr,&flg);
229: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"MPI_Comm does not have tag/name counter nor does it have inner MPI_Comm");
230: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
231: PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));
232: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
233: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
234: }
235: counter->refcount--;
236: if (!counter->refcount) {
238: /* if MPI_Comm has outer comm then remove reference to inner MPI_Comm from outer MPI_Comm */
239: MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,&flg);
240: if (flg) {
241: /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */
242: PetscMemcpy(&ocomm,&ptr,sizeof(MPI_Comm));
243: MPI_Attr_get(ocomm,Petsc_InnerComm_keyval,&ptr,&flg);
244: if (flg) {
245: MPI_Attr_delete(ocomm,Petsc_InnerComm_keyval);
246: } else SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Outer MPI_Comm %ld does not have expected reference to inner comm %d, problem with corrupted memory",(long int)ocomm,(long int)icomm);
247: }
249: PetscInfo1(0,"Deleting PETSc MPI_Comm %ld\n",(long)icomm);
250: MPI_Comm_free(&icomm);
251: }
252: *comm = 0;
253: return(0);
254: }