1 #include "zpetsc.h" 2 3 void *PETSCNULLPOINTERADDRESS = PETSC_NULL; 4 5 /*MC 6 PetscFortranAddr - a variable type in Fortran that can hold a 7 regular C pointer. 8 9 Notes: Used, for example, as the file argument in PetscFOpen() 10 11 Level: beginner 12 13 .seealso: PetscOffset, PetscInt 14 M*/ 15 /*MC 16 PetscOffset - a variable type in Fortran used with VecGetArray() 17 and ISGetIndices() 18 19 Level: beginner 20 21 .seealso: PetscFortranAddr, PetscInt 22 M*/ 23 24 /* 25 This is code for translating PETSc memory addresses to integer offsets 26 for Fortran. 27 */ 28 char *PETSC_NULL_CHARACTER_Fortran = 0; 29 void *PETSC_NULL_INTEGER_Fortran = 0; 30 void *PETSC_NULL_OBJECT_Fortran = 0; 31 void *PETSC_NULL_Fortran = 0; 32 void *PETSC_NULL_SCALAR_Fortran = 0; 33 void *PETSC_NULL_DOUBLE_Fortran = 0; 34 void *PETSC_NULL_REAL_Fortran = 0; 35 EXTERN_C_BEGIN 36 void (*PETSC_NULL_FUNCTION_Fortran)(void) = 0; 37 EXTERN_C_END 38 size_t PetscIntAddressToFortran(PetscInt *base,PetscInt *addr) 39 { 40 size_t tmp1 = (size_t) base,tmp2 = 0; 41 size_t tmp3 = (size_t) addr; 42 size_t itmp2; 43 44 #if !defined(PETSC_HAVE_CRAY90_POINTER) 45 if (tmp3 > tmp1) { 46 tmp2 = (tmp3 - tmp1)/sizeof(PetscInt); 47 itmp2 = (size_t) tmp2; 48 } else { 49 tmp2 = (tmp1 - tmp3)/sizeof(PetscInt); 50 itmp2 = -((size_t) tmp2); 51 } 52 #else 53 if (tmp3 > tmp1) { 54 tmp2 = (tmp3 - tmp1); 55 itmp2 = (size_t) tmp2; 56 } else { 57 tmp2 = (tmp1 - tmp3); 58 itmp2 = -((size_t) tmp2); 59 } 60 #endif 61 62 if (base + itmp2 != addr) { 63 (*PetscErrorPrintf)("PetscIntAddressToFortran:C and Fortran arrays are\n"); 64 (*PetscErrorPrintf)("not commonly aligned or are too far apart to be indexed \n"); 65 (*PetscErrorPrintf)("by an integer. Locations: C %uld Fortran %uld\n",tmp1,tmp3); 66 MPI_Abort(PETSC_COMM_WORLD,1); 67 } 68 return itmp2; 69 } 70 71 PetscInt *PetscIntAddressFromFortran(PetscInt *base,size_t addr) 72 { 73 return base + addr; 74 } 75 76 /* 77 obj - PETSc object on which request is made 78 base - Fortran array address 79 addr - C array address 80 res - will contain offset from C to Fortran 81 shift - number of bytes that prevent base and addr from being commonly aligned 82 N - size of the array 83 84 align indicates alignment relative to PetscScalar, 1 means aligned on PetscScalar, 2 means aligned on 2 PetscScalar etc 85 */ 86 PetscErrorCode PetscScalarAddressToFortran(PetscObject obj,PetscInt align,PetscScalar *base,PetscScalar *addr,PetscInt N,size_t *res) 87 { 88 size_t tmp1 = (size_t) base,tmp2 = tmp1/sizeof(PetscScalar); 89 size_t tmp3 = (size_t) addr; 90 size_t itmp2; 91 PetscInt shift; 92 93 #if !defined(PETSC_HAVE_CRAY90_POINTER) 94 if (tmp3 > tmp1) { /* C is bigger than Fortran */ 95 tmp2 = (tmp3 - tmp1)/sizeof(PetscScalar); 96 itmp2 = (size_t) tmp2; 97 shift = (align*sizeof(PetscScalar) - (PetscInt)((tmp3 - tmp1) % (align*sizeof(PetscScalar)))) % (align*sizeof(PetscScalar)); 98 } else { 99 tmp2 = (tmp1 - tmp3)/sizeof(PetscScalar); 100 itmp2 = -((size_t) tmp2); 101 shift = (PetscInt)((tmp1 - tmp3) % (align*sizeof(PetscScalar))); 102 } 103 #else 104 if (tmp3 > tmp1) { /* C is bigger than Fortran */ 105 tmp2 = (tmp3 - tmp1); 106 itmp2 = (size_t) tmp2; 107 } else { 108 tmp2 = (tmp1 - tmp3); 109 itmp2 = -((size_t) tmp2); 110 } 111 shift = 0; 112 #endif 113 114 if (shift) { 115 /* 116 Fortran and C not PetscScalar aligned,recover by copying values into 117 memory that is aligned with the Fortran 118 */ 119 PetscErrorCode ierr; 120 PetscScalar *work; 121 PetscObjectContainer container; 122 123 ierr = PetscMalloc((N+align)*sizeof(PetscScalar),&work);CHKERRQ(ierr); 124 125 /* recompute shift for newly allocated space */ 126 tmp3 = (size_t) work; 127 if (tmp3 > tmp1) { /* C is bigger than Fortran */ 128 shift = (align*sizeof(PetscScalar) - (PetscInt)((tmp3 - tmp1) % (align*sizeof(PetscScalar)))) % (align*sizeof(PetscScalar)); 129 } else { 130 shift = (PetscInt)((tmp1 - tmp3) % (align*sizeof(PetscScalar))); 131 } 132 133 /* shift work by that number of bytes */ 134 work = (PetscScalar*)(((char*)work) + shift); 135 ierr = PetscMemcpy(work,addr,N*sizeof(PetscScalar));CHKERRQ(ierr); 136 137 /* store in the first location in addr how much you shift it */ 138 ((PetscInt*)addr)[0] = shift; 139 140 ierr = PetscObjectContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 141 ierr = PetscObjectContainerSetPointer(container,addr);CHKERRQ(ierr); 142 ierr = PetscObjectCompose(obj,"GetArrayPtr",(PetscObject)container);CHKERRQ(ierr); 143 144 tmp3 = (size_t) work; 145 if (tmp3 > tmp1) { /* C is bigger than Fortran */ 146 tmp2 = (tmp3 - tmp1)/sizeof(PetscScalar); 147 itmp2 = (size_t) tmp2; 148 shift = (align*sizeof(PetscScalar) - (PetscInt)((tmp3 - tmp1) % (align*sizeof(PetscScalar)))) % (align*sizeof(PetscScalar)); 149 } else { 150 tmp2 = (tmp1 - tmp3)/sizeof(PetscScalar); 151 itmp2 = -((size_t) tmp2); 152 shift = (PetscInt)((tmp1 - tmp3) % (align*sizeof(PetscScalar))); 153 } 154 if (shift) { 155 (*PetscErrorPrintf)("PetscScalarAddressToFortran:C and Fortran arrays are\n"); 156 (*PetscErrorPrintf)("not commonly aligned.\n"); 157 /* double/int doesn't work with ADIC */ 158 (*PetscErrorPrintf)("Locations/sizeof(PetscScalar): C %f Fortran %f\n", 159 ((PetscReal)tmp3)/(PetscReal)sizeof(PetscScalar),((PetscReal)tmp1)/(PetscReal)sizeof(PetscScalar)); 160 MPI_Abort(PETSC_COMM_WORLD,1); 161 } 162 ierr = PetscInfo((void*)obj,"Efficiency warning, copying array in XXXGetArray() due\n\ 163 to alignment differences between C and Fortran\n");CHKERRQ(ierr); 164 } 165 *res = itmp2; 166 return 0; 167 } 168 169 /* 170 obj - the PETSc object where the scalar pointer came from 171 base - the Fortran array address 172 addr - the Fortran offset from base 173 N - the amount of data 174 175 lx - the array space that is to be passed to XXXXRestoreArray() 176 */ 177 PetscErrorCode PetscScalarAddressFromFortran(PetscObject obj,PetscScalar *base,size_t addr,PetscInt N,PetscScalar **lx) 178 { 179 PetscErrorCode ierr; 180 PetscInt shift; 181 PetscObjectContainer container; 182 PetscScalar *tlx; 183 184 ierr = PetscObjectQuery(obj,"GetArrayPtr",(PetscObject *)&container);CHKERRQ(ierr); 185 if (container) { 186 ierr = PetscObjectContainerGetPointer(container,(void**)lx);CHKERRQ(ierr); 187 tlx = base + addr; 188 189 shift = *(PetscInt*)*lx; 190 ierr = PetscMemcpy(*lx,tlx,N*sizeof(PetscScalar));CHKERRQ(ierr); 191 tlx = (PetscScalar*)(((char *)tlx) - shift); 192 ierr = PetscFree(tlx);CHKERRQ(ierr); 193 ierr = PetscObjectContainerDestroy(container);CHKERRQ(ierr); 194 ierr = PetscObjectCompose(obj,"GetArrayPtr",0);CHKERRQ(ierr); 195 } else { 196 *lx = base + addr; 197 } 198 return 0; 199 } 200 201 #undef __FUNCT__ 202 #define __FUNCT__ "MPICCommToFortranComm" 203 /*@C 204 MPICCommToFortranComm - Converts a MPI_Comm represented 205 in C to one appropriate to pass to a Fortran routine. 206 207 Not collective 208 209 Input Parameter: 210 . cobj - the C MPI_Comm 211 212 Output Parameter: 213 . fobj - the Fortran MPI_Comm 214 215 Level: advanced 216 217 Notes: 218 MPICCommToFortranComm() must be called in a C/C++ routine. 219 MPI 1 does not provide a standard for mapping between 220 Fortran and C MPI communicators; this routine handles the 221 mapping correctly on all machines. 222 223 .keywords: Fortran, C, MPI_Comm, convert, interlanguage 224 225 .seealso: MPIFortranCommToCComm() 226 @*/ 227 PetscErrorCode MPICCommToFortranComm(MPI_Comm comm,int *fcomm) 228 { 229 PetscErrorCode ierr; 230 PetscMPIInt size; 231 232 PetscFunctionBegin; 233 /* call to MPI_Comm_size() is for error checking on comm */ 234 ierr = MPI_Comm_size(comm,&size); 235 if (ierr) SETERRQ(PETSC_ERR_ARG_CORRUPT ,"Invalid MPI communicator"); 236 237 *fcomm = PetscFromPointerComm(comm); 238 PetscFunctionReturn(0); 239 } 240 241 #undef __FUNCT__ 242 #define __FUNCT__ "MPIFortranCommToCComm" 243 /*@C 244 MPIFortranCommToCComm - Converts a MPI_Comm represented 245 int Fortran (as an integer) to a MPI_Comm in C. 246 247 Not collective 248 249 Input Parameter: 250 . fcomm - the Fortran MPI_Comm (an integer) 251 252 Output Parameter: 253 . comm - the C MPI_Comm 254 255 Level: advanced 256 257 Notes: 258 MPIFortranCommToCComm() must be called in a C/C++ routine. 259 MPI 1 does not provide a standard for mapping between 260 Fortran and C MPI communicators; this routine handles the 261 mapping correctly on all machines. 262 263 .keywords: Fortran, C, MPI_Comm, convert, interlanguage 264 265 .seealso: MPICCommToFortranComm() 266 @*/ 267 PetscErrorCode MPIFortranCommToCComm(int fcomm,MPI_Comm *comm) 268 { 269 PetscErrorCode ierr; 270 PetscMPIInt size; 271 272 PetscFunctionBegin; 273 *comm = (MPI_Comm)PetscToPointerComm(fcomm); 274 /* call to MPI_Comm_size() is for error checking on comm */ 275 ierr = MPI_Comm_size(*comm,&size); 276 if (ierr) SETERRQ(PETSC_ERR_ARG_CORRUPT,"Invalid MPI communicator"); 277 PetscFunctionReturn(0); 278 } 279 280 281 282