Actual source code: tagm.c
1: /*
2: Some PETSc utilites
3: */
4: #include petscsys.h
5: #if defined(PETSC_HAVE_STDLIB_H)
6: #include <stdlib.h>
7: #endif
9: /* ---------------------------------------------------------------- */
10: /*
11: A simple way to manage tags inside a private
12: communicator. It uses the attribute to determine if a new communicator
13: is needed.
15: Notes on the implementation
17: The tagvalues to use are stored in a two element array. The first element
18: is the first free tag value. The second is used to indicate how
19: many "copies" of the communicator there are used in destroying.
20: */
22: static PetscMPIInt Petsc_Tag_keyval = MPI_KEYVAL_INVALID;
27: /*
28: Private routine to delete internal storage when a communicator is freed.
29: This is called by MPI, not by users.
31: The binding for the first argument changed from MPI 1.0 to 1.1; in 1.0
32: it was MPI_Comm *comm.
36: */
37: PetscMPIInt Petsc_DelTag(MPI_Comm comm,PetscMPIInt keyval,void* attr_val,void* extra_state)
38: {
42: PetscLogInfo(0,"Petsc_DelTag:Deleting tag data in an MPI_Comm %ld\n",(long)comm);
43: PetscFree(attr_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
44: PetscFunctionReturn(MPI_SUCCESS);
45: }
50: /*@C
51: PetscObjectGetNewTag - Gets a unique new tag from a PETSc object. All
52: processors that share the object MUST call this routine EXACTLY the same
53: number of times. This tag should only be used with the current objects
54: communicator; do NOT use it with any other MPI communicator.
56: Collective on PetscObject
58: Input Parameter:
59: . obj - the PETSc object; this must be cast with a (PetscObject), for example,
60: PetscObjectGetNewTag((PetscObject)mat,&tag);
62: Output Parameter:
63: . tag - the new tag
65: Level: developer
67: Concepts: tag^getting
68: Concepts: message tag^getting
69: Concepts: MPI message tag^getting
71: .seealso: PetscCommGetNewTag()
72: @*/
73: PetscErrorCode PetscObjectGetNewTag(PetscObject obj,PetscMPIInt *tag)
74: {
76: PetscMPIInt *tagvalp = 0,*maxval;
77: PetscTruth flg;
83: MPI_Attr_get(obj->comm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
84: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator in PETSc object, likely memory corruption");
86: if (tagvalp[0] < 1) {
87: PetscLogInfo(0,"Out of tags for object, starting to recycle. Number tags issued %d",tagvalp[1]);
88: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
89: if (!flg) {
90: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
91: }
92: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
93: }
94: *tag = tagvalp[0]--;
95: return(0);
96: }
100: /*@C
101: PetscCommGetNewTag - Gets a unique new tag from a PETSc communicator. All
102: processors that share the communicator MUST call this routine EXACTLY the same
103: number of times. This tag should only be used with the current objects
104: communicator; do NOT use it with any other MPI communicator.
106: Collective on comm
108: Input Parameter:
109: . comm - the PETSc communicator
111: Output Parameter:
112: . tag - the new tag
114: Level: developer
116: Concepts: tag^getting
117: Concepts: message tag^getting
118: Concepts: MPI message tag^getting
120: .seealso: PetscObjectGetNewTag(), PetscCommDuplicate()
121: @*/
122: PetscErrorCode PetscCommGetNewTag(MPI_Comm comm,PetscMPIInt *tag)
123: {
125: PetscMPIInt *tagvalp=0,*maxval;
126: PetscTruth flg;
131: MPI_Attr_get(comm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
132: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator");
135: if (tagvalp[0] < 1) {
136: PetscLogInfo(0,"Out of tags for object, starting to recycle. Number tags issued %d",tagvalp[1]);
137: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
138: if (!flg) {
139: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
140: }
141: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
142: }
144: *tag = tagvalp[0]--;
145: return(0);
146: }
150: /*@C
151: PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc
152: communicator.
154: Collective on MPI_Comm
156: Input Parameters:
157: . comm_in - Input communicator
159: Output Parameters:
160: + comm_out - Output communicator. May be comm_in.
161: - first_tag - Tag available that has not already been used with this communicator (you may
162: pass in PETSC_NULL if you do not need a tag)
164: PETSc communicators are just regular MPI communicators that keep track of which
165: tags have been used to prevent tag conflict. If you pass a non-PETSc communicator into
166: a PETSc creation routine it will be duplicated for use in the object.
168: Level: developer
170: Concepts: communicator^duplicate
172: .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag()
173: @*/
174: PetscErrorCode PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,PetscMPIInt* first_tag)
175: {
177: PetscMPIInt *tagvalp,*maxval;
178: PetscTruth flg;
181: if (Petsc_Tag_keyval == MPI_KEYVAL_INVALID) {
182: /*
183: The calling sequence of the 2nd argument to this function changed
184: between MPI Standard 1.0 and the revisions 1.1 Here we match the
185: new standard, if you are using an MPI implementation that uses
186: the older version you will get a warning message about the next line;
187: it is only a warning message and should do no harm.
188: */
189: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelTag,&Petsc_Tag_keyval,(void*)0);
190: }
192: MPI_Attr_get(comm_in,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
194: if (!flg) {
195: /* This communicator is not yet known to this system, so we duplicate it and set its value */
196: MPI_Comm_dup(comm_in,comm_out);
197: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
198: if (!flg) {
199: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
200: }
201: PetscMalloc(2*sizeof(PetscMPIInt),&tagvalp);
202: tagvalp[0] = *maxval;
203: tagvalp[1] = 0;
204: MPI_Attr_put(*comm_out,Petsc_Tag_keyval,tagvalp);
205: PetscLogInfo(0,"PetscCommDuplicate: Duplicating a communicator %ld %ld max tags = %d\n",(long)comm_in,(long)*comm_out,*maxval);
206: } else {
207: #if defined(PETSC_USE_BOPT_g)
208: PetscMPIInt tag;
209: MPI_Allreduce(tagvalp,&tag,1,MPI_INT,MPI_BOR,comm_in);
210: if (tag != tagvalp[0]) {
211: SETERRQ(PETSC_ERR_ARG_CORRUPT,"Communicator was used on subset of processors.");
212: }
213: #endif
214: *comm_out = comm_in;
215: }
217: if (tagvalp[0] < 1) {
218: PetscLogInfo(0,"Out of tags for object, starting to recycle. Number tags issued %d",tagvalp[1]);
219: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(PetscMPIInt*)&flg);
220: if (!flg) {
221: SETERRQ(PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
222: }
223: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
224: }
226: if (first_tag) {
227: *first_tag = tagvalp[0]--;
228: tagvalp[1]++;
229: }
230: return(0);
231: }
235: /*@C
236: PetscCommDestroy - Frees communicator. Use in conjunction with PetscCommDuplicate().
238: Collective on MPI_Comm
240: Input Parameter:
241: . comm - the communicator to free
243: Level: developer
245: Concepts: communicator^destroy
247: @*/
248: PetscErrorCode PetscCommDestroy(MPI_Comm *comm)
249: {
251: PetscMPIInt *tagvalp;
252: PetscTruth flg;
255: MPI_Attr_get(*comm,Petsc_Tag_keyval,(void**)&tagvalp,(PetscMPIInt*)&flg);
256: if (!flg) {
257: SETERRQ(PETSC_ERR_ARG_CORRUPT,"Error freeing MPI_Comm, problem with corrupted memory");
258: }
259: tagvalp[1]--;
260: if (!tagvalp[1]) {
261: PetscLogInfo(0,"PetscCommDestroy:Deleting MPI_Comm %ld\n",(long)*comm);
262: MPI_Comm_free(comm);
263: }
264: return(0);
265: }