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.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 00303 void c_structpcgsetprintlevel_(long int * solver, int * level, int * ierr) { 00304 00305 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00306 00307 *ierr = HYPRE_StructPCGSetPrintLevel(csolver, *level); 00308 00309 } 00310 00311 void c_structpcgdestroy_(long int * solver, int * ierr) { 00312 00313 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00314 00315 *ierr = HYPRE_StructPCGDestroy(csolver); 00316 } 00317 00318 /***************************** End PCG solver functions ********************************/ 00319 00320 00321 /********************************* GMRES solver functions ************************************/ 00322 00323 void c_structgmrescreate_(long int * comm, long int * solver, int * ierr) { 00324 00325 MPI_Comm commval = (MPI_Comm)(*comm); 00326 HYPRE_StructSolver csolver; 00327 00328 *ierr = HYPRE_StructGMRESCreate(MPI_COMM_WORLD, &csolver); 00329 00330 *solver = (long int)csolver; 00331 00332 } 00333 00334 void c_structgmresdestroy_(long int * solver, int * ierr) { 00335 00336 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00337 00338 *ierr = HYPRE_StructGMRESDestroy(csolver); 00339 } 00340 00341 void c_structgmressetup_(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00342 00343 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00344 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00345 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00346 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00347 00348 *ierr = HYPRE_StructGMRESSetup(csolver, cmatrix, c_bvector, c_xvector); 00349 } 00350 00351 void c_structgmressolve_(long int * solver, long int * matrix, long int * bvector, long int *xvector, int * ierr) { 00352 00353 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00354 HYPRE_StructMatrix cmatrix = (HYPRE_StructMatrix)(*matrix); 00355 HYPRE_StructVector c_bvector = (HYPRE_StructVector)(*bvector); 00356 HYPRE_StructVector c_xvector = (HYPRE_StructVector)(*xvector); 00357 00358 *ierr = HYPRE_StructGMRESSolve(csolver, cmatrix, c_bvector, c_xvector); 00359 } 00360 00361 void c_structgmressettol_(long int * solver, double * tol, int * ierr) { 00362 00363 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00364 00365 *ierr = HYPRE_StructGMRESSetTol(csolver, *tol); 00366 } 00367 00368 void c_structgmressetmaxiter_(long int * solver, int * max_iter, int * ierr) { 00369 00370 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00371 00372 *ierr = HYPRE_StructGMRESSetMaxIter(csolver, *max_iter); 00373 } 00374 00375 void c_structgmresgetnumiterations_(long int * solver, int * num_iter, int * ierr) { 00376 00377 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00378 00379 *ierr = HYPRE_StructGMRESGetNumIterations(csolver, num_iter); 00380 } 00381 00382 void c_structgmressetprintlevel_(long int * solver, int * level, int * ierr) { 00383 00384 HYPRE_StructSolver csolver = (HYPRE_StructSolver)(*solver); 00385 00386 *ierr = HYPRE_StructGMRESSetPrintLevel(csolver, *level); 00387 00388 } 00389 00390 00391 /********************************* End GMRES solver functions *********************************/ 00392 00393 00399 /******************************* SStructGrid functions *********************************/ 00400 00401 void c_sstructgridcreate_(long int * mpicomm, int * dim, int * nparts, long int * grid, int * ierr) { 00402 00403 HYPRE_SStructGrid cgrid; 00404 00405 *ierr = HYPRE_SStructGridCreate(MPI_COMM_WORLD, *dim, *nparts, &cgrid); 00406 00407 *grid = (long int)cgrid; 00408 } 00409 00410 void c_sstructgridsetextents_(long int * grid, int * part, int * lower, int * upper, int * ierr) { 00411 00412 HYPRE_SStructGrid cgrid = (HYPRE_SStructGrid)(*grid); 00413 00414 *ierr = HYPRE_SStructGridSetExtents(cgrid, *part, lower, upper); 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 **********************************/