1 #define PETSC_DLL 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 9 10 /* ---------------------------------------------------------------- */ 11 /* 12 A simple way to manage tags inside a communicator. 13 14 It uses the attributes to determine if a new communicator 15 is needed and to store the available tags. 16 17 */ 18 19 20 #undef __FUNCT__ 21 #define __FUNCT__ "PetscObjectGetNewTag" 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. 27 28 Collective on PetscObject 29 30 Input Parameter: 31 . obj - the PETSc object; this must be cast with a (PetscObject), for example, 32 PetscObjectGetNewTag((PetscObject)mat,&tag); 33 34 Output Parameter: 35 . tag - the new tag 36 37 Level: developer 38 39 Concepts: tag^getting 40 Concepts: message tag^getting 41 Concepts: MPI message tag^getting 42 43 .seealso: PetscCommGetNewTag() 44 @*/ 45 PetscErrorCode PETSC_DLLEXPORT PetscObjectGetNewTag(PetscObject obj,PetscMPIInt *tag) 46 { 47 PetscErrorCode ierr; 48 49 PetscFunctionBegin; 50 ierr = PetscCommGetNewTag(obj->comm,tag);CHKERRQ(ierr); 51 PetscFunctionReturn(0); 52 } 53 54 #undef __FUNCT__ 55 #define __FUNCT__ "PetscCommGetNewTag" 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. 61 62 Collective on comm 63 64 Input Parameter: 65 . comm - the MPI communicator 66 67 Output Parameter: 68 . tag - the new tag 69 70 Level: developer 71 72 Concepts: tag^getting 73 Concepts: message tag^getting 74 Concepts: MPI message tag^getting 75 76 .seealso: PetscObjectGetNewTag(), PetscCommDuplicate() 77 @*/ 78 PetscErrorCode PETSC_DLLEXPORT PetscCommGetNewTag(MPI_Comm comm,PetscMPIInt *tag) 79 { 80 PetscErrorCode ierr; 81 PetscCommCounter *counter; 82 PetscMPIInt *maxval,flg; 83 84 PetscFunctionBegin; 85 PetscValidIntPointer(tag,2); 86 87 ierr = MPI_Attr_get(comm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 88 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator"); 89 90 if (counter->tag < 1) { 91 ierr = PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",counter->refcount);CHKERRQ(ierr); 92 ierr = MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);CHKERRQ(ierr); 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 } 96 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 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 103 #endif 104 PetscFunctionReturn(0); 105 } 106 107 #undef __FUNCT__ 108 #define __FUNCT__ "PetscCommDuplicate" 109 /*@C 110 PetscCommDuplicate - Duplicates the communicator only if it is not already a PETSc communicator. 111 112 Collective on MPI_Comm 113 114 Input Parameters: 115 . comm_in - Input communicator 116 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) 121 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 outter 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. 127 128 Level: developer 129 130 Concepts: communicator^duplicate 131 132 .seealso: PetscObjectGetNewTag(), PetscCommGetNewTag(), PetscCommDestroy() 133 @*/ 134 PetscErrorCode PETSC_DLLEXPORT PetscCommDuplicate(MPI_Comm comm_in,MPI_Comm *comm_out,PetscMPIInt* first_tag) 135 { 136 PetscErrorCode ierr; 137 PetscCommCounter *counter; 138 PetscMPIInt *maxval,flg; 139 140 PetscFunctionBegin; 141 ierr = MPI_Attr_get(comm_in,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 142 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 ierr = MPI_Attr_get(comm_in,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 147 if (!flg) { 148 /* This communicator is not yet known to this system, so we duplicate it and make an internal communicator */ 149 ierr = MPI_Comm_dup(comm_in,comm_out);CHKERRQ(ierr); 150 ierr = MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);CHKERRQ(ierr); 151 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI error: MPI_Attr_get() is not returning a MPI_TAG_UB"); 152 ierr = PetscMalloc(sizeof(PetscCommCounter),&counter);CHKERRQ(ierr); 153 counter->tag = *maxval; 154 counter->refcount = 0; 155 counter->namecount = 0; 156 ierr = MPI_Attr_put(*comm_out,Petsc_Counter_keyval,counter);CHKERRQ(ierr); 157 ierr = PetscInfo3(0,"Duplicating a communicator %ld %ld max tags = %d\n",(long)comm_in,(long)*comm_out,*maxval);CHKERRQ(ierr); 158 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 ierr = PetscMemcpy(&ptr,comm_out,sizeof(MPI_Comm));CHKERRQ(ierr); 162 ierr = MPI_Attr_put(comm_in,Petsc_InnerComm_keyval,ptr);CHKERRQ(ierr); 163 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 164 ierr = PetscMemcpy(&ptr,&comm_in,sizeof(MPI_Comm));CHKERRQ(ierr); 165 ierr = MPI_Attr_put(*comm_out,Petsc_OuterComm_keyval,ptr);CHKERRQ(ierr); 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 ierr = PetscMemcpy(comm_out,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 170 ierr = MPI_Attr_get(*comm_out,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 171 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Inner PETSc communicator does not have its tag/name counter attribute set"); 172 ierr = PetscInfo2(0,"Using internal PETSc communicator %ld %ld\n",(long)comm_in,(long)*comm_out);CHKERRQ(ierr); 173 } 174 } else { 175 *comm_out = comm_in; 176 } 177 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 ierr = MPI_Barrier(comm_in);CHKERRQ(ierr); 185 #endif 186 187 if (counter->tag < 1) { 188 ierr = PetscInfo1(0,"Out of tags for object, starting to recycle. Comm reference count %d\n",counter->refcount);CHKERRQ(ierr); 189 ierr = MPI_Attr_get(MPI_COMM_WORLD,MPI_TAG_UB,&maxval,&flg);CHKERRQ(ierr); 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 } 193 194 if (first_tag) { 195 *first_tag = counter->tag--; 196 ierr = PetscInfo1(0," returning tag %ld\n",(long)*first_tag);CHKERRQ(ierr); 197 } 198 counter->refcount++; /* number of references to this comm */ 199 PetscFunctionReturn(0); 200 } 201 202 #undef __FUNCT__ 203 #define __FUNCT__ "PetscCommDestroy" 204 /*@C 205 PetscCommDestroy - Frees communicator. Use in conjunction with PetscCommDuplicate(). 206 207 Collective on MPI_Comm 208 209 Input Parameter: 210 . comm - the communicator to free 211 212 Level: developer 213 214 Concepts: communicator^destroy 215 216 .seealso: PetscCommDuplicate() 217 @*/ 218 PetscErrorCode PETSC_DLLEXPORT PetscCommDestroy(MPI_Comm *comm) 219 { 220 PetscErrorCode ierr; 221 PetscCommCounter *counter; 222 PetscMPIInt flg; 223 MPI_Comm icomm = *comm,ocomm; 224 void *ptr; 225 226 PetscFunctionBegin; 227 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 228 if (!flg) { /* not a PETSc comm, check if it has an inner comm */ 229 ierr = MPI_Attr_get(icomm,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 230 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"); 231 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 232 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 233 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 234 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 235 } 236 counter->refcount--; 237 if (!counter->refcount) { 238 239 /* if MPI_Comm has outter comm then remove reference to inner MPI_Comm from outter MPI_Comm */ 240 ierr = MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,&flg);CHKERRQ(ierr); 241 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 242 ierr = PetscMemcpy(&ocomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 243 if (flg) { 244 ierr = MPI_Attr_delete(ocomm,Petsc_InnerComm_keyval);CHKERRQ(ierr); 245 } 246 247 ierr = PetscInfo1(0,"Deleting PETSc MPI_Comm %ld\n",(long)icomm);CHKERRQ(ierr); 248 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 249 } 250 PetscFunctionReturn(0); 251 } 252 253