1 /*---------------------------------------------------------------
2 * Programmer(s): Daniel R. Reynolds @ SMU
3 *---------------------------------------------------------------
4 * SUNDIALS Copyright Start
5 * Copyright (c) 2002-2020, Lawrence Livermore National Security
6 * and Southern Methodist University.
7 * All rights reserved.
8 *
9 * See the top-level LICENSE and NOTICE files for details.
10 *
11 * SPDX-License-Identifier: BSD-3-Clause
12 * SUNDIALS Copyright End
13 *---------------------------------------------------------------
14 * Fortran/C interface routines for ARKODE/ARKLS, for the case
15 * of a user-supplied mass-matrix approximation routine.
16 *--------------------------------------------------------------*/
17
18 #include <stdio.h>
19 #include <stdlib.h>
20 #include "farkode.h"
21 #include "arkode_impl.h"
22 #include <arkode/arkode_arkstep.h>
23 #include <sunmatrix/sunmatrix_sparse.h>
24
25 /*=============================================================*/
26
27 /* Prototype of the Fortran routine */
28
29 #ifdef __cplusplus /* wrapper to enable C++ usage */
30 extern "C" {
31 #endif
32
33 extern void FARK_SPMASS(realtype *T, long int *N,
34 long int *NNZ, realtype *MDATA,
35 sunindextype *MRVALS, sunindextype *MCPTRS,
36 long int *IPAR, realtype *RPAR,
37 realtype *V1, realtype *V2, realtype *V3,
38 int *ier);
39
40 #ifdef __cplusplus
41 }
42 #endif
43
44 /*=============================================================*/
45
46 /* Fortran interface to C routine ARKSlsSetMassFn; see
47 farkode.h for further information */
FARK_SPARSESETMASS(int * ier)48 void FARK_SPARSESETMASS(int *ier)
49 {
50 *ier = ARKStepSetMassFn(ARK_arkodemem, FARKSparseMass);
51 }
52
53 /*=============================================================*/
54
55 /* C interface to user-supplied Fortran routine FARKSPMASS; see
56 farkode.h for additional information */
FARKSparseMass(realtype t,SUNMatrix MassMat,void * user_data,N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3)57 int FARKSparseMass(realtype t, SUNMatrix MassMat, void *user_data,
58 N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
59 {
60 int ier;
61 realtype *v1data, *v2data, *v3data, *Mdata;
62 FARKUserData ARK_userdata;
63 long int NP, NNZ;
64 sunindextype *indexvals, *indexptrs;
65
66 v1data = N_VGetArrayPointer(vtemp1);
67 v2data = N_VGetArrayPointer(vtemp2);
68 v3data = N_VGetArrayPointer(vtemp3);
69 NP = SUNSparseMatrix_NP(MassMat);
70 NNZ = SUNSparseMatrix_NNZ(MassMat);
71 Mdata = SUNSparseMatrix_Data(MassMat);
72 indexvals = SUNSparseMatrix_IndexValues(MassMat);
73 indexptrs = SUNSparseMatrix_IndexPointers(MassMat);
74 ARK_userdata = (FARKUserData) user_data;
75
76 FARK_SPMASS(&t, &NP, &NNZ, Mdata, indexvals, indexptrs,
77 ARK_userdata->ipar, ARK_userdata->rpar, v1data,
78 v2data, v3data, &ier);
79 return(ier);
80 }
81
82 /*===============================================================
83 EOF
84 ===============================================================*/
85