Actual source code: tagm.c
1: /*$Id: tagm.c,v 1.33 2001/03/23 23:20:38 balay Exp $*/
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 private
13: communicator. It uses the attribute to determine if a new communicator
14: is needed.
16: Notes on the implementation
18: The tagvalues to use are stored in a two element array. The first element
19: is the first free tag value. The second is used to indicate how
20: many "copies" of the communicator there are used in destroying.
21: */
23: static int Petsc_Tag_keyval = MPI_KEYVAL_INVALID;
25: EXTERN_C_BEGIN
28: /*
29: Private routine to delete internal storage when a communicator is freed.
30: This is called by MPI, not by users.
32: The binding for the first argument changed from MPI 1.0 to 1.1; in 1.0
33: it was MPI_Comm *comm.
35: Note: this is declared extern "C" because it is passed to the system routine signal()
36: which is an extern "C" routine. The Solaris 2.7 OS compilers require that this be
37: extern "C".
38: */
39: int Petsc_DelTag(MPI_Comm comm,int keyval,void* attr_val,void* extra_state)
40: {
44: PetscLogInfo(0,"Petsc_DelTag:Deleting tag data in an MPI_Comm %ld\n",(long)comm);
45: PetscFree(attr_val);
46: PetscFunctionReturn(MPI_SUCCESS);
47: }
48: EXTERN_C_END
52: /*@C
53: PetscObjectGetNewTag - Gets a unique new tag from a PETSc object. All
54: processors that share the object MUST call this routine EXACTLY the same
55: number of times. This tag should only be used with the current objects
56: communicator; do NOT use it with any other MPI communicator.
58: Collective on PetscObject
60: Input Parameter:
61: . obj - the PETSc object; this must be cast with a (PetscObject), for example,
62: PetscObjectGetNewTag((PetscObject)mat,&tag);
64: Output Parameter:
65: . tag - the new tag
67: Level: developer
69: Concepts: tag^getting
70: Concepts: message tag^getting
71: Concepts: MPI message tag^getting
73: .seealso: PetscCommGetNewTag()
74: @*/
75: int PetscObjectGetNewTag(PetscObject obj,int *tag)
76: {
77: int ierr,*tagvalp=0,*maxval;
78: PetscTruth flg;
84: MPI_Attr_get(obj->comm,Petsc_Tag_keyval,(void**)&tagvalp,(int*)&flg);
85: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator in PETSc object, likely memory corruption");
87: if (tagvalp[0] < 1) {
88: PetscLogInfo(0,"Out of tags for object, starting to recycle. Number tags issued %d",tagvalp[1]);
89: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(int*)&flg);
90: if (!flg) {
91: SETERRQ(1,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
92: }
93: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
94: }
96: *tag = tagvalp[0]--;
97: return(0);
98: }
102: /*@C
103: PetscCommGetNewTag - Gets a unique new tag from a PETSc communicator. All
104: processors that share the communicator MUST call this routine EXACTLY the same
105: number of times. This tag should only be used with the current objects
106: communicator; do NOT use it with any other MPI communicator.
108: Collective on comm
110: Input Parameter:
111: . comm - the PETSc communicator
113: Output Parameter:
114: . tag - the new tag
116: Level: developer
118: Concepts: tag^getting
119: Concepts: message tag^getting
120: Concepts: MPI message tag^getting
122: .seealso: PetscObjectGetNewTag(), PetscCommDuplicate()
123: @*/
124: int PetscCommGetNewTag(MPI_Comm comm,int *tag)
125: {
126: int ierr,*tagvalp=0,*maxval;
127: PetscTruth flg;
132: MPI_Attr_get(comm,Petsc_Tag_keyval,(void**)&tagvalp,(int*)&flg);
133: if (!flg) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator");
136: if (tagvalp[0] < 1) {
137: PetscLogInfo(0,"Out of tags for object, starting to recycle. Number tags issued %d",tagvalp[1]);
138: MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,(void**)&maxval,(int*)&flg);
139: if (!flg) {
140: SETERRQ(1,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
141: }
142: tagvalp[0] = *maxval - 128; /* hope that any still active tags were issued right at the beginning of the run */
143: }
145: *tag = tagvalp[0]--;
146: return(0);
147: }
151: /*@C
152: PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc
153: communicator.
155: Collective on MPI_Comm
157: Input Parameters:
158: . comm_in - Input communicator
160: Output Parameters:
161: + comm_out - Output communicator. May be comm_in.
162: - first_tag - Tag available that has not already been used with this communicator (you may
163: pass in PETSC_NULL if you do not need a tag)
165: PETSc communicators are just regular MPI communicators that keep track of which
166: tags have been used to prevent tag conflict. If you pass a non-PETSc communicator into
167: a PETSc creation routine it will be duplicated for use in the object.
169: Level: developer
171: Concepts: communicator^duplicate
173: .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag()
174: @*/
175: int PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,int* first_tag)
176: {
177: int ierr,*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,(int*)&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,(int*)&flg);
198: if (!flg) {
199: SETERRQ(1,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB");
200: }
201: PetscMalloc(2*sizeof(int),&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: int 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,(int*)&flg);
220: if (!flg) {
221: SETERRQ(1,"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: int PetscCommDestroy(MPI_Comm *comm)
249: {
250: int ierr,*tagvalp;
251: PetscTruth flg;
254: MPI_Attr_get(*comm,Petsc_Tag_keyval,(void**)&tagvalp,(int*)&flg);
255: if (!flg) {
256: SETERRQ(PETSC_ERR_ARG_CORRUPT,"Error freeing MPI_Comm, problem with corrupted memory");
257: }
258: tagvalp[1]--;
259: if (!tagvalp[1]) {
260: PetscLogInfo(0,"PetscCommDestroy:Deleting MPI_Comm %ld\n",(long)*comm);
261: MPI_Comm_free(comm);
262: }
263: return(0);
264: }