Scrambler
1
|
00001 //######################################################################### 00002 // 00003 // Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 // University of Rochester, 00005 // Rochester, NY 00006 // 00007 // extended_hypre_wrapper.bg.c is part of AstroBEAR. 00008 // 00009 // AstroBEAR is free software: you can redistribute it and/or modify 00010 // it under the terms of the GNU General Public License as published by 00011 // the Free Software Foundation, either version 3 of the License, or 00012 // (at your option) any later version. 00013 // 00014 // AstroBEAR is distributed in the hope that it will be useful, 00015 // but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 // GNU General Public License for more details. 00018 // 00019 // You should have received a copy of the GNU General Public License 00020 // along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. 00021 // 00022 //######################################################################### 00027 /* 00028 File Name: hypre_wrapper.c 00029 00030 Created: 20090603 by Brandon D. Shroyer 00031 00032 Purpose: Provide a Fortran-friendly interface for C-based Hypre functions. 00033 00034 Description:The principle problem handled by this file is the fact that Fortran passes 00035 function arguments by reference, whereas C passes them by value. To that 00036 end, this library is simply a series of functions that take reference 00037 inputs and then "clean them up" before using them to execute a HYPRE 00038 subroutine. This clean-up process consists of dereferencing simple types 00039 where necessary, and performing type casting on the derived types passed 00040 in by Fortran. 00041 00042 Note the underscore after each wrapper function name. Apparently this 00043 is required to make Linux Fortran compilers recognize these C constructs 00044 as functions. 00045 00046 Also note that Fortran function names are case-insensitive, whereas C 00047 functions are not. The Fortran compilers we use convert Fortran 00048 code to lower-case before passing it to other libraries, which is why 00049 all the wrapper function names are all lower-case. 00050 00051 Notes: [BDS][20090604]: Due to type conversion problems, we're using MPI_COMM_WORLD 00052 to initialize the Hypre structures now. We hope to figure 00053 out the problem someday, so we're leaving the mpicomm 00054 parameters in place, but they currently have no effect 00055 on the construction of the Hypre data structures. 00056 00057 */ 00058 #include "extended_hypre_wrapper.h" 00059 #include "HYPRE_struct_ls.h" 00060 #include "HYPRE_sstruct_ls.h" 00061 #include <stdio.h> 00062 #include <assert.h> 00063 00064 /****************************** StructGrid functions ***********************************/ 00065 00066 void c_structgridcreate(long int * mpicomm, int * dim, long int * grid, int * ierr) { 00067 00068 HYPRE_StructGrid cgrid; 00069 00070 *ierr = HYPRE_StructGridCreate(MPI_COMM_WORLD, *dim, &cgrid); 00071 00072 *grid = (long int)cgrid; 00073 } 00074 00075 void c_structgridsetextents(long int * grid, int * lower, int * upper, int * ierr) { 00076 00077 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00078 00079 *ierr = HYPRE_StructGridSetExtents(cgrid, lower, upper); 00080 } 00081 00082 void c_structgridsetperiodic(long int * grid, int * periodicoffset, int * ierr) { 00083 00084 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00085 00086 *ierr = HYPRE_StructGridSetPeriodic(cgrid, periodicoffset); 00087 } 00088 00089 00090 void c_structgridassemble(long int * grid, int * ierr) { 00091 00092 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00093 00094 *ierr = HYPRE_StructGridAssemble(cgrid); 00095 } 00096 00097 void c_structgriddestroy(long int * grid, int * ierr) { 00098 00099 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00100 00101 *ierr = HYPRE_StructGridDestroy(cgrid); 00102 } 00103 00104 /***************************** End StructGrid functions ********************************/ 00105 00106 /****************************** StructStencil functions ********************************/ 00107 00108 void c_structstencilcreate(int * dim, int * size, long int * stencil, int * ierr) { 00109 00110 HYPRE_StructStencil cstencil; 00111 00112 *ierr = HYPRE_StructStencilCreate(*dim, *size, &cstencil); 00113 00114 *stencil = (long int)cstencil; 00115 } 00116 00117 void c_structstencilsetelement(long int * stencil, int *entry, int *offset, int * ierr) { 00118 00119 HYPRE_StructStencil cstencil = (HYPRE_StructStencil)(*stencil); 00120 00121 *ierr = HYPRE_StructStencilSetElement(cstencil, *entry, offset); 00122 } 00123 00124 void c_structstencildestroy(long int * stencil, int * ierr) { 00125 00126 HYPRE_StructStencil cstencil = (HYPRE_StructStencil)(*stencil); 00127 00128 *ierr = HYPRE_StructStencilDestroy(cstencil); 00129 } 00130 00131 /**************************** End StructStencil functions ******************************/ 00132 00133 /******************************* StructMatrix functions ********************************/ 00134 00135 void c_structmatrixcreate(long int * mpicomm, long int * grid, long int * stencil, long int * matrix, int * ierr) { 00136 00137 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00138 HYPRE_StructStencil cstencil = (HYPRE_StructStencil)(*stencil); 00139 HYPRE_StructMatrix cmatrix; 00140 00141 *ierr = HYPRE_StructMatrixCreate(MPI_COMM_WORLD, cgrid, cstencil, &cmatrix); 00142 00143 *matrix = (long int)cmatrix; 00144 } 00145 00146 void c_structmatrixinitialize(long int * matrix, int * ierr) { 00147 00148 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00149 00150 *ierr = HYPRE_StructMatrixInitialize(cmatrix); 00151 } 00152 00153 void c_structmatrixsetboxvalues(long int * matrix, int * lower, int * upper, int * nentries, int * entries, double * values, int * ierr) { 00154 00155 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00156 00157 /* printf("matrix is %d\n",*matrix); 00158 printf("lower is %d %d %d\n",lower[0],lower[1],lower[2]); 00159 printf("upper is %d %d %d\n",upper[0],upper[1],upper[2]); 00160 printf("nentries is %d\n",*nentries); 00161 printf("entries is %d %d %d %d %d\n",entries[0],entries[1],entries[2],entries[3],entries[4]); 00162 00163 printf("the first few entries in the matrix are %lf %lf %lf %lf %lf %lf %lf %lf %lf",values[0],values[1],values[2],values[3],values[4],values[5],values[6],values[7],values[8],values[9]); */ 00164 *ierr = HYPRE_StructMatrixSetBoxValues (cmatrix, lower, upper, *nentries, entries, values); 00165 00166 } 00167 00168 void c_structmatrixassemble(long int * matrix, int * ierr) { 00169 00170 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00171 00172 *ierr = HYPRE_StructMatrixAssemble(cmatrix); 00173 } 00174 00175 void c_structmatrixdestroy(long int * matrix, int * ierr) { 00176 00177 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00178 00179 *ierr = HYPRE_StructMatrixDestroy(cmatrix); 00180 } 00181 00182 /***************************** End StructMatrix functions ******************************/ 00183 00184 /******************************* StructVector functions ********************************/ 00185 00186 void c_structvectorcreate(long int * mpicomm, long int * grid, long int * vector, int * ierr) { 00187 00188 HYPRE_StructGrid cgrid = (HYPRE_StructGrid)(*grid); 00189 HYPRE_StructVector cvector; 00190 00191 *ierr = HYPRE_StructVectorCreate (MPI_COMM_WORLD, cgrid, &cvector); 00192 00193 *vector = (long int)cvector; 00194 } 00195 00196 void c_structvectorinitialize(long int * vector, int * ierr) { 00197 00198 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00199 00200 *ierr = HYPRE_StructVectorInitialize(cvector); 00201 00202 } 00203 00204 void c_structvectorsetboxvalues(long int * vector, int * lower, int * upper, double * values, int * ierr) { 00205 00206 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00207 00208 *ierr = HYPRE_StructVectorSetBoxValues (cvector, lower, upper, values); 00209 } 00210 00211 void c_structvectorgetboxvalues(long int * vector, int * lower, int * upper, double * values, int * ierr) { 00212 00213 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00214 00215 *ierr = HYPRE_StructVectorGetBoxValues(cvector, lower, upper, values); 00216 } 00217 00218 00219 void c_structvectorassemble(long int * vector, int * ierr) { 00220 00221 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00222 00223 *ierr = HYPRE_StructVectorAssemble(cvector); 00224 00225 } 00226 00227 void c_structvectorprint(char * filename, long int * vector, int * var3, int * ierr) { 00228 00229 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00230 00231 *ierr = HYPRE_StructVectorPrint(filename, cvector, *var3); 00232 00233 } 00234 00235 void c_structmatrixprint(char * filename, long int * matrix, int * all, int * ierr) { 00236 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00237 *ierr = HYPRE_StructMatrixPrint(filename, cmatrix, *all); 00238 } 00239 00240 00241 void c_structvectordestroy(long int * vector, int * ierr) { 00242 00243 HYPRE_StructVector cvector = (HYPRE_StructVector)(*vector); 00244 00245 *ierr = HYPRE_StructVectorDestroy(cvector); 00246 } 00247 00248 /***************************** End StructVector functions ******************************/ 00249 00250 /******************************* PCG solver functions **********************************/ 00251 00252 void c_structpcgcreate(long int * mpicomm, long int * solver, int * ierr) { 00253 00254 HYPRE_StructSolver csolver; 00255 00256 *ierr = HYPRE_StructPCGCreate(MPI_COMM_WORLD, &csolver); 00257 00258 *solver = (long int)csolver; 00259 } 00260 00261 void c_structpcgsetup(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00262 00263 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00264 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00265 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00266 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00267 00268 *ierr = HYPRE_StructPCGSetup(csolver, cmatrix, c_bvector, c_xvector); 00269 } 00270 00271 void c_structpcgsolve(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00272 00273 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00274 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00275 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00276 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00277 00278 *ierr = HYPRE_StructPCGSolve(csolver, cmatrix, c_bvector, c_xvector); 00279 } 00280 00281 void c_structpcgsettol(long int * solver, double * tol, int * ierr) { 00282 00283 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00284 00285 *ierr = HYPRE_StructPCGSetTol(csolver, *tol); 00286 } 00287 00288 void c_structpcgsetmaxiter(long int * solver, int * max_iter, int * ierr) { 00289 00290 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00291 00292 *ierr = HYPRE_StructPCGSetMaxIter(csolver, *max_iter); 00293 } 00294 00295 void c_structpcggetnumiterations(long int * solver, int * num_iter, int * ierr) { 00296 00297 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00298 00299 *ierr = HYPRE_StructPCGGetNumIterations(csolver, num_iter); 00300 } 00301 00302 void c_structpcgsetprintlevel(long int * solver, int * level, int * ierr) { 00303 00304 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00305 00306 *ierr = HYPRE_StructPCGSetPrintLevel(csolver, *level); 00307 00308 } 00309 00310 void c_structpcgdestroy(long int * solver, int * ierr) { 00311 00312 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00313 00314 *ierr = HYPRE_StructPCGDestroy(csolver); 00315 } 00316 00317 /***************************** End PCG solver functions ********************************/ 00318 00319 00320 /********************************* GMRES solver functions ************************************/ 00321 00322 void c_structgmrescreate(long int * comm, long int * solver, int * ierr) { 00323 00324 MPI_Comm commval = (MPI_Comm)(*comm); 00325 HYPRE_StructSolver csolver; 00326 00327 *ierr = HYPRE_StructGMRESCreate(MPI_COMM_WORLD, &csolver); 00328 00329 *solver = (long int)csolver; 00330 00331 } 00332 00333 void c_structgmresdestroy(long int * solver, int * ierr) { 00334 00335 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00336 00337 *ierr = HYPRE_StructGMRESDestroy(csolver); 00338 } 00339 00340 void c_structgmressetup(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00341 00342 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00343 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00344 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00345 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00346 00347 *ierr = HYPRE_StructGMRESSetup(csolver, cmatrix, c_bvector, c_xvector); 00348 } 00349 00350 void c_structgmressolve(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00351 00352 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00353 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00354 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00355 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00356 00357 *ierr = HYPRE_StructGMRESSolve(csolver, cmatrix, c_bvector, c_xvector); 00358 } 00359 00360 void c_structgmressettol(long int * solver, double * tol, int * ierr) { 00361 00362 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00363 00364 *ierr = HYPRE_StructGMRESSetTol(csolver, *tol); 00365 } 00366 00367 void c_structgmressetmaxiter(long int * solver, int * max_iter, int * ierr) { 00368 00369 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00370 00371 *ierr = HYPRE_StructGMRESSetMaxIter(csolver, *max_iter); 00372 } 00373 00374 void c_structgmresgetnumiterations(long int * solver, int * num_iter, int * ierr) { 00375 00376 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00377 00378 *ierr = HYPRE_StructGMRESGetNumIterations(csolver, num_iter); 00379 } 00380 00381 void c_structgmressetprintlevel(long int * solver, int * level, int * ierr) { 00382 00383 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00384 00385 *ierr = HYPRE_StructGMRESSetPrintLevel(csolver, *level); 00386 00387 } 00388 00389 00390 /********************************* End GMRES solver functions *********************************/ 00391 00392 00398 /******************************* SStructGrid functions *********************************/ 00399 00400 void c_sstructgridcreate(long int * mpicomm, int * dim, int * nparts, long int * grid, int * ierr) { 00401 00402 HYPRE_SStructGrid cgrid; 00403 00404 *ierr = HYPRE_SStructGridCreate(MPI_COMM_WORLD, *dim, *nparts, &cgrid); 00405 00406 *grid = (long int)cgrid; 00407 } 00408 00409 void c_sstructgridsetextents(long int * grid, int * part, int * lower, int * upper, int * ierr) { 00410 00411 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00412 00413 *ierr = HYPRE_SStructGridSetExtents(cgrid, *part, lower, upper); 00414 } 00415 00416 00417 void c_sstructgridsetvariables(long int * grid, int * part, int * nvars, int * ierr) { 00418 00419 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00420 HYPRE_SStructVariable vartypes[1] = {HYPRE_SSTRUCT_VARIABLE_CELL}; 00421 00422 00423 *ierr = HYPRE_SStructGridSetVariables(cgrid, *part, *nvars, vartypes); 00424 } 00425 00426 void c_sstructgridassemble(long int * grid, int * ierr) { 00427 00428 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00429 00430 *ierr = HYPRE_SStructGridAssemble(cgrid); 00431 } 00432 00433 void c_sstructgridsetperiodic(long int * grid, int * part, int * periodicoffset, int * ierr) { 00434 00435 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00436 00437 *ierr = HYPRE_SStructGridSetPeriodic(cgrid, *part, periodicoffset); 00438 } 00439 00440 void c_sstructgriddestroy(long int * grid, int * ierr) { 00441 00442 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00443 00444 *ierr = HYPRE_SStructGridDestroy(cgrid); 00445 } 00446 00447 void c_sstructgridsetnumghost(long int * grid, int * num_ghost, int * ierr) { 00448 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00449 00450 *ierr = HYPRE_SStructGridSetNumGhost(cgrid, num_ghost); 00451 } 00452 00453 /***************************** End SStructGrid functions *******************************/ 00454 00455 /****************************** SStructStencil functions *******************************/ 00456 00457 void c_sstructstencilcreate(int * dim, int * size, long int * stencil, int * ierr) { 00458 00459 HYPRE_SStructStencil cstencil; 00460 00461 *ierr = HYPRE_SStructStencilCreate(*dim, *size, &cstencil); 00462 00463 *stencil = (long int)cstencil; 00464 } 00465 00466 void c_sstructstencilsetentry(long int * stencil, int *entry, int *offset, int * var, int * ierr) { 00467 00468 HYPRE_SStructStencil cstencil = (HYPRE_SStructStencil)(*stencil); 00469 00470 *ierr = HYPRE_SStructStencilSetEntry(cstencil, *entry, offset, *var); 00471 } 00472 00473 void c_sstructstencildestroy(long int * stencil, int * ierr) { 00474 00475 HYPRE_SStructStencil cstencil = (HYPRE_SStructStencil)(*stencil); 00476 00477 *ierr = HYPRE_SStructStencilDestroy(cstencil); 00478 } 00479 00480 /**************************** End SStructStencil functions *****************************/ 00481 00482 /******************************* SStructGraph functions ********************************/ 00483 00484 void c_sstructgraphcreate(long int * mpicomm, long int * grid, long int * graph, int * ierr) { 00485 00486 /* MPI_Comm commval = (MPI_Comm)(*mpicomm);*/ 00487 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00488 HYPRE_SStructGraph cgraph; 00489 00490 *ierr = HYPRE_SStructGraphCreate(MPI_COMM_WORLD, cgrid, &cgraph); 00491 00492 *graph = (long int)cgraph; 00493 } 00494 00495 void c_sstructgraphsetstencil(long int * graph, int * part, int * var, long int * stencil, int * ierr) { 00496 00497 HYPRE_SStructGraph cgraph = (HYPRE_SStructGraph)(*graph); 00498 HYPRE_SStructStencil cstencil = (HYPRE_SStructStencil)(*stencil); 00499 00500 *ierr = HYPRE_SStructGraphSetStencil(cgraph, *part, *var, cstencil); 00501 } 00502 00503 void c_sstructgraphaddentries(long int * graph, int * part, int * index, int * var, int * to_part, int * to_index, int * to_var, int * ierr) { 00504 00505 HYPRE_SStructGraph cgraph = (HYPRE_SStructGraph)(*graph); 00506 int cfrom_index[3], cto_index[3]; 00507 00508 cfrom_index[0] = index[0]; 00509 cfrom_index[1] = index[1]; 00510 cfrom_index[2] = index[2]; 00511 00512 cto_index[0] = to_index[0]; 00513 cto_index[1] = to_index[1]; 00514 cto_index[2] = to_index[2]; 00515 00516 00517 /*printf("SStructGraphAddEntries([%d, %d, %d] => [%d, %d, %d].\n", index[0], index[1], index[2], to_index[0], to_index[1], to_index[2]);*/ 00518 00519 /*if (((cto_index[0] == 1) && (cto_index[1] == 64)) || ((cfrom_index[0] == 1) && (cfrom_index[1] == 64))) {*/ 00520 /*printf("SStructGraphAddEntries[graph=%d, part=%d, index=[%d, %d, %d], var=%d, to_part=%d, to_index=[%d, %d, %d], to_var=%d.\n", *graph, *part, cfrom_index[0], cfrom_index[1], cfrom_index[2], *var, *to_part, cto_index[0], cto_index[1], cto_index[2], *to_var); 00521 }*/ 00522 *ierr = HYPRE_SStructGraphAddEntries(cgraph, *part, cfrom_index, *var, *to_part, cto_index, *to_var); 00523 00524 } 00525 00526 void c_sstructgraphassemble(long int * graph, int * ierr) { 00527 00528 HYPRE_SStructGraph cgraph = (HYPRE_SStructGraph)(*graph); 00529 00530 *ierr = HYPRE_SStructGraphAssemble(cgraph); 00531 } 00532 00533 void c_sstructgraphdestroy(long int * graph, int * ierr) { 00534 00535 HYPRE_SStructGraph cgraph = (HYPRE_SStructGraph)(*graph); 00536 00537 *ierr = HYPRE_SStructGraphAssemble(cgraph); 00538 } 00539 00540 /***************************** End SStructGraph functions ******************************/ 00541 00542 /****************************** SStructMatrix functions ********************************/ 00543 00544 void c_sstructmatrixcreate(long int * mpicomm, long int * graph, long int * matrix, int * ierr) { 00545 00546 HYPRE_SStructGraph cgraph = (HYPRE_SStructGraph)(*graph); 00547 HYPRE_SStructMatrix cmatrix; 00548 00549 *ierr = HYPRE_SStructMatrixCreate(MPI_COMM_WORLD, cgraph, &cmatrix); 00550 00551 *matrix = (long int)cmatrix; 00552 } 00553 00554 void c_sstructmatrixsetobjecttype(long int * matrix, int * obj_type, int * ierr) { 00555 00556 int ctype; 00557 00558 switch(*obj_type) { 00559 case F_HYPRE_STRUCT: 00560 ctype = HYPRE_STRUCT; 00561 break; 00562 case F_HYPRE_SSTRUCT: 00563 ctype = HYPRE_SSTRUCT; 00564 break; 00565 case F_HYPRE_PARCSR: 00566 ctype = HYPRE_PARCSR; 00567 break; 00568 default: 00569 printf("C_SStructMatrixSetObjectType error: invalid Fortran object code %d.\n", *obj_type); 00570 } 00571 00572 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00573 00574 *ierr = HYPRE_SStructMatrixSetObjectType(cmatrix, ctype); 00575 } 00576 00577 void c_sstructmatrixgetobject(long int * matrix, long int * object, int * ierr) { 00578 00579 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00580 HYPRE_ParCSRMatrix cobject; 00581 00582 *ierr = HYPRE_SStructMatrixGetObject(cmatrix, (void **)&cobject); 00583 00584 *object = (long int)(cobject); 00585 00586 } 00587 00588 void c_sstructmatrixinitialize(long int * matrix, int * ierr) { 00589 00590 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00591 00592 *ierr = HYPRE_SStructMatrixInitialize(cmatrix); 00593 } 00594 00595 void c_sstructmatrixsetboxvalues(long int * matrix, int * part, int * lower, int * upper, int * var, int * nentries, int * entries, double * values, int * ierr) { 00596 00597 int dummy[1]; 00598 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00599 00600 *ierr = HYPRE_SStructMatrixSetBoxValues (cmatrix, *part, lower, upper, *var, *nentries, entries, values); 00601 } 00602 00603 void c_sstructmatrixsetvalues(long int * matrix, int * part, int * index, int * var, int * nentries, int * entries, double * values, int * ierr) { 00604 00605 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00606 int array_length = *nentries; 00607 int centries[*nentries]; 00608 double cvalues[*nentries]; 00609 int dummy[1]; 00610 int i; 00611 00612 for(i = 0; i < array_length; i++) { 00613 centries[i] = entries[i]; 00614 cvalues[i] = values[i]; 00615 } 00616 00617 /* 00618 printf("SStructMatrixSetValues(%ld, %d, [%d, %d, %d], %d, %d, [%d, %d], [%f, %f]).\n", *matrix, *part, index[0], index[1], index[2], *var, *nentries, centries[0], centries[1], cvalues[0], cvalues[1]); 00619 */ 00620 00621 *ierr = HYPRE_SStructMatrixSetValues(cmatrix, *part, index, *var, *nentries, centries, cvalues); 00622 00623 } 00624 00625 void c_sstructmatrixassemble(long int * matrix, int * ierr) { 00626 00627 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00628 00629 *ierr = HYPRE_SStructMatrixAssemble(cmatrix); 00630 } 00631 00632 void c_sstructmatrixdestroy(long int * matrix, int * ierr) { 00633 00634 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00635 00636 *ierr = HYPRE_SStructMatrixDestroy(cmatrix); 00637 } 00638 00639 void c_sstructmatrixprint(char * filename, long int * matrix, int * all, int * ierr) { 00640 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00641 *ierr = HYPRE_SStructMatrixPrint(filename, cmatrix, *all); 00642 } 00643 /**************************** End SStructMatrix functions *****************************/ 00644 00645 /****************************** SStructVector functions *******************************/ 00646 00647 void c_sstructvectorcreate(long int * mpicomm, long int * grid, long int * vector, int * ierr) { 00648 00649 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00650 HYPRE_SStructVector cvector; 00651 00652 *ierr = HYPRE_SStructVectorCreate (MPI_COMM_WORLD, cgrid, &cvector); 00653 00654 *vector = (long int)cvector; 00655 } 00656 00657 void c_sstructvectorinitialize(long int * vector, int * ierr) { 00658 00659 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00660 00661 *ierr = HYPRE_SStructVectorInitialize(cvector); 00662 00663 } 00664 00665 void c_sstructvectorsetboxvalues(long int * vector, int * part, int * lower, int * upper, int * var, double * values, int * ierr) { 00666 00667 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00668 00669 *ierr = HYPRE_SStructVectorSetBoxValues (cvector, *part, lower, upper, *var, values); 00670 } 00671 00672 void c_sstructvectorgetboxvalues(long int * vector, int * part, int * lower, int * upper, int * var, double * values, int * ierr) { 00673 00674 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00675 00676 *ierr = HYPRE_SStructVectorGetBoxValues(cvector, *part, lower, upper, *var, values); 00677 } 00678 00679 void c_sstructvectorsetobjecttype(long int * vector, int * obj_type, int * ierr) { 00680 00681 int ctype; 00682 00683 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00684 00685 switch(*obj_type) { 00686 case F_HYPRE_STRUCT: 00687 ctype = HYPRE_STRUCT; 00688 break; 00689 case F_HYPRE_SSTRUCT: 00690 ctype = HYPRE_SSTRUCT; 00691 break; 00692 case F_HYPRE_PARCSR: 00693 ctype = HYPRE_PARCSR; 00694 break; 00695 default: 00696 printf("C_SStructVectorSetObjectType error: invalid Fortran object code %d.\n", *obj_type); 00697 } 00698 00699 00700 *ierr = HYPRE_SStructVectorSetObjectType(cvector, ctype); 00701 00702 } 00703 00704 void c_sstructvectorgetobject(long int * vector, long int * object, int * ierr) { 00705 00706 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00707 HYPRE_ParVector cobject; 00708 00709 *ierr = HYPRE_SStructVectorGetObject(cvector, (void **)&cobject); 00710 00711 *object = (long int)(*object); 00712 00713 } 00714 00715 void c_sstructvectorgather(long int * vector, int * ierr) { 00716 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00717 00718 *ierr = HYPRE_SStructVectorGather(cvector); 00719 } 00720 00721 void c_sstructvectorassemble(long int * vector, int * ierr) { 00722 00723 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00724 00725 *ierr = HYPRE_SStructVectorAssemble(cvector); 00726 00727 } 00728 00729 void c_sstructvectorprint(char * filename, long int * vector, int * var3, int * ierr) { 00730 00731 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00732 00733 *ierr = HYPRE_SStructVectorPrint(filename, cvector, *var3); 00734 00735 } 00736 00737 void c_sstructvectordestroy(long int * vector, int * ierr) { 00738 00739 HYPRE_SStructVector cvector = (HYPRE_SStructVector)(*vector); 00740 00741 *ierr = HYPRE_SStructVectorDestroy(cvector); 00742 } 00743 00744 /***************************** End StructVector functions ******************************/ 00745 00746 /******************************* PCG solver functions **********************************/ 00747 00748 void c_sstructpcgcreate(long int * mpicomm, long int * solver, int * ierr) { 00749 00750 HYPRE_SStructSolver csolver; 00751 00752 *ierr = HYPRE_SStructPCGCreate(MPI_COMM_WORLD, &csolver); 00753 00754 *solver = (long int)csolver; 00755 } 00756 00757 void c_sstructpcgsetup(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00758 00759 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00760 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00761 HYPRE_SStructVector c_bvector = (HYPRE_SStructVector)(*bvector); 00762 HYPRE_SStructVector c_xvector = (HYPRE_SStructVector)(*xvector); 00763 00764 *ierr = HYPRE_SStructPCGSetup(csolver, cmatrix, c_bvector, c_xvector); 00765 } 00766 00767 void c_sstructpcgsolve(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00768 00769 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00770 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00771 HYPRE_SStructVector c_bvector = (HYPRE_SStructVector)(*bvector); 00772 HYPRE_SStructVector c_xvector = (HYPRE_SStructVector)(*xvector); 00773 00774 *ierr = HYPRE_SStructPCGSolve(csolver, cmatrix, c_bvector, c_xvector); 00775 } 00776 00777 void c_sstructpcgsettol(long int * solver, double * tol, int * ierr) { 00778 00779 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00780 00781 *ierr = HYPRE_SStructPCGSetTol(csolver, *tol); 00782 } 00783 00784 void c_sstructpcgsetprintlevel(long int * solver, int * level, int * ierr) { 00785 00786 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00787 00788 *ierr = HYPRE_SStructPCGSetPrintLevel(csolver, *level); 00789 00790 } 00791 00792 void c_sstructpcgdestroy(long int * solver, int * ierr) { 00793 00794 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00795 00796 *ierr = HYPRE_SStructPCGDestroy(csolver); 00797 } 00798 00799 /***************************** End PCG solver functions ********************************/ 00800 00801 00802 /******************************* ParCSRPCG solver functions **********************************/ 00803 00804 void c_parcsrpcgcreate(long int * comm, long int * solver, int * ierr) { 00805 00806 MPI_Comm commval = (MPI_Comm)(*comm); 00807 HYPRE_Solver csolver; 00808 00809 *ierr = HYPRE_ParCSRPCGCreate(MPI_COMM_WORLD, &csolver); 00810 00811 *solver = (long int)csolver; 00812 00813 } 00814 00815 void c_parcsrpcgsettol(long int * solver, double * tol, int * ierr) { 00816 HYPRE_Solver csolver = (HYPRE_Solver)(*solver); 00817 00818 *ierr = HYPRE_ParCSRPCGSetTol(csolver, *tol); 00819 } 00820 00821 void c_parcsrpcgsetup(long int * solver, long int * matrix, long int * bvector, long int * xvector, int * ierr) { 00822 HYPRE_Solver csolver = (HYPRE_Solver)(*solver); 00823 HYPRE_ParCSRMatrix cmatrix = (HYPRE_ParCSRMatrix)(*matrix); 00824 HYPRE_ParVector cbvector = (HYPRE_ParVector)(*bvector); 00825 HYPRE_ParVector cxvector = (HYPRE_ParVector)(*xvector); 00826 00827 *ierr = HYPRE_ParCSRPCGSetup(csolver, cmatrix, cbvector, cxvector); 00828 } 00829 00830 void c_parcsrpcgsolve(long int * solver, long int * matrix, long int * bvector, long int * xvector, int * ierr) { 00831 HYPRE_Solver csolver = (HYPRE_Solver)(*solver); 00832 HYPRE_ParCSRMatrix cmatrix = (HYPRE_ParCSRMatrix)(*matrix); 00833 HYPRE_ParVector cbvector = (HYPRE_ParVector)(*bvector); 00834 HYPRE_ParVector cxvector = (HYPRE_ParVector)(*xvector); 00835 00836 *ierr = HYPRE_ParCSRPCGSolve(csolver, cmatrix, cbvector, cxvector); 00837 } 00838 00839 void c_parcsrpcgsetprintlevel(long int * solver, int * print_level, int * ierr) { 00840 HYPRE_Solver csolver = (HYPRE_Solver)(*solver); 00841 00842 *ierr = HYPRE_ParCSRPCGSetPrintLevel(csolver, *print_level); 00843 } 00844 00845 void c_parcsrpcgdestroy(long int * solver, int * ierr) { 00846 HYPRE_Solver csolver = (HYPRE_Solver)(*solver); 00847 00848 *ierr = HYPRE_ParCSRPCGDestroy(csolver); 00849 } 00850 00851 void c_parcsrgotime(long int * matrix, long int * varvector, long int * solvector, double * tol, int * printlevel, int * ierr) { 00852 HYPRE_Solver csolver; 00853 HYPRE_ParCSRMatrix A; 00854 HYPRE_ParVector b; 00855 HYPRE_ParVector x; 00856 int commrank; 00857 00858 *ierr = MPI_Comm_rank(MPI_COMM_WORLD, &commrank); 00859 00860 HYPRE_SStructMatrix Amatrix = (HYPRE_SStructMatrix)(*matrix); 00861 HYPRE_SStructVector bvector = (HYPRE_SStructVector)(*varvector); 00862 HYPRE_SStructVector xvector = (HYPRE_SStructVector)(*solvector); 00863 00864 *ierr = HYPRE_SStructMatrixGetObject(Amatrix, (void **) &A); 00865 *ierr = HYPRE_SStructVectorGetObject(bvector, (void **) &b); 00866 *ierr = HYPRE_SStructVectorGetObject(xvector, (void **) &x); 00867 00868 *ierr = HYPRE_ParCSRPCGCreate(MPI_COMM_WORLD, &csolver); 00869 assert(*ierr == 0); 00870 00871 *ierr = HYPRE_ParCSRPCGSetTol(csolver, *tol); 00872 assert(*ierr == 0); 00873 00874 *ierr = HYPRE_ParCSRPCGSetPrintLevel(csolver, *printlevel); 00875 assert(*ierr == 0); 00876 00877 *ierr = HYPRE_ParCSRPCGSetup(csolver, A, b, x); 00878 assert(*ierr == 0); 00879 00880 *ierr = HYPRE_ParCSRPCGSolve(csolver, A, b, x); 00881 assert(*ierr == 0); 00882 00883 *ierr = HYPRE_ParCSRPCGDestroy(csolver); 00884 assert(*ierr == 0); 00885 00886 } 00887 00888 /***************************** End ParCSRPCG solver functions ********************************/ 00889 00890 /********************************* GMRES solver functions ************************************/ 00891 00892 void c_sstructgmrescreate(long int * comm, long int * solver, int * ierr) { 00893 00894 MPI_Comm commval = (MPI_Comm)(*comm); 00895 HYPRE_SStructSolver csolver; 00896 00897 *ierr = HYPRE_SStructGMRESCreate(MPI_COMM_WORLD, &csolver); 00898 00899 *solver = (long int)csolver; 00900 00901 } 00902 00903 void c_sstructgmresdestroy(long int * solver, int * ierr) { 00904 00905 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00906 00907 *ierr = HYPRE_SStructGMRESDestroy(csolver); 00908 } 00909 00910 void c_sstructgmressetup(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00911 00912 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00913 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00914 HYPRE_SStructVector c_bvector = (HYPRE_SStructVector)(*bvector); 00915 HYPRE_SStructVector c_xvector = (HYPRE_SStructVector)(*xvector); 00916 00917 *ierr = HYPRE_SStructGMRESSetup(csolver, cmatrix, c_bvector, c_xvector); 00918 } 00919 00920 void c_sstructgmressolve(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00921 00922 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00923 HYPRE_SStructMatrix cmatrix = (HYPRE_SStructMatrix)(*matrix); 00924 HYPRE_SStructVector c_bvector = (HYPRE_SStructVector)(*bvector); 00925 HYPRE_SStructVector c_xvector = (HYPRE_SStructVector)(*xvector); 00926 00927 *ierr = HYPRE_SStructGMRESSolve(csolver, cmatrix, c_bvector, c_xvector); 00928 } 00929 00930 void c_sstructgmressettol(long int * solver, double * tol, int * ierr) { 00931 00932 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00933 00934 *ierr = HYPRE_SStructGMRESSetTol(csolver, *tol); 00935 } 00936 00937 void c_sstructgmressetprintlevel(long int * solver, int * level, int * ierr) { 00938 00939 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00940 00941 *ierr = HYPRE_SStructGMRESSetPrintLevel(csolver, *level); 00942 00943 } 00944 00945 void c_sstructgmressetkdim(long int * solver, int * k_dim, int * ierr) { 00946 00947 HYPRE_SStructSolver csolver = (HYPRE_SStructSolver)(*solver); 00948 00949 *ierr = HYPRE_SStructGMRESSetKDim(csolver, *k_dim); 00950 00951 } 00952 00953 /********************************* End GMRES solver functions *********************************/ 00954 00955 00956 /******************************** Start PFMG solver functions *********************************/ 00957 00958 /********************************* End PFMG solver functions **********************************/