1 /*
2 * -----------------------------------------------------------------
3 * Programmer(s): Daniel Reynolds @ SMU
4 * -----------------------------------------------------------------
5 * SUNDIALS Copyright Start
6 * Copyright (c) 2002-2021, Lawrence Livermore National Security
7 * and Southern Methodist University.
8 * All rights reserved.
9 *
10 * See the top-level LICENSE and NOTICE files for details.
11 *
12 * SPDX-License-Identifier: BSD-3-Clause
13 * SUNDIALS Copyright End
14 * -----------------------------------------------------------------
15 * This file (companion of fsunlinsol_spgmr.h) contains the
16 * implementation needed for the Fortran initialization of SPGMR
17 * linear solver operations.
18 * -----------------------------------------------------------------
19 */
20
21 #include <stdio.h>
22 #include <stdlib.h>
23
24 #include "fsunlinsol_spgmr.h"
25
26 /* Define global linsol variables */
27
28 SUNLinearSolver F2C_CVODE_linsol;
29 SUNLinearSolver F2C_IDA_linsol;
30 SUNLinearSolver F2C_KINSOL_linsol;
31 SUNLinearSolver F2C_ARKODE_linsol;
32 SUNLinearSolver F2C_ARKODE_mass_sol;
33
34 /* Declarations of external global variables */
35
36 extern SUNMatrix F2C_CVODE_matrix;
37 extern SUNMatrix F2C_IDA_matrix;
38 extern SUNMatrix F2C_KINSOL_matrix;
39 extern SUNMatrix F2C_ARKODE_matrix;
40 extern SUNMatrix F2C_ARKODE_mass_matrix;
41
42 extern N_Vector F2C_CVODE_vec;
43 extern N_Vector F2C_IDA_vec;
44 extern N_Vector F2C_KINSOL_vec;
45 extern N_Vector F2C_ARKODE_vec;
46
47 /* Fortran callable interfaces */
48
FSUNSPGMR_INIT(int * code,int * pretype,int * maxl,int * ier)49 void FSUNSPGMR_INIT(int *code, int *pretype, int *maxl, int *ier)
50 {
51 *ier = 0;
52
53 switch(*code) {
54 case FCMIX_CVODE:
55 if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol);
56 F2C_CVODE_linsol = NULL;
57 F2C_CVODE_linsol = SUNLinSol_SPGMR(F2C_CVODE_vec, *pretype, *maxl);
58 if (F2C_CVODE_linsol == NULL) *ier = -1;
59 break;
60 case FCMIX_IDA:
61 if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol);
62 F2C_IDA_linsol = NULL;
63 F2C_IDA_linsol = SUNLinSol_SPGMR(F2C_IDA_vec, *pretype, *maxl);
64 if (F2C_IDA_linsol == NULL) *ier = -1;
65 break;
66 case FCMIX_KINSOL:
67 if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol);
68 F2C_KINSOL_linsol = NULL;
69 F2C_KINSOL_linsol = SUNLinSol_SPGMR(F2C_KINSOL_vec, *pretype, *maxl);
70 if (F2C_KINSOL_linsol == NULL) *ier = -1;
71 break;
72 case FCMIX_ARKODE:
73 if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol);
74 F2C_ARKODE_linsol = NULL;
75 F2C_ARKODE_linsol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl);
76 if (F2C_ARKODE_linsol == NULL) *ier = -1;
77 break;
78 default:
79 *ier = -1;
80 }
81 }
82
83
FSUNSPGMR_SETGSTYPE(int * code,int * gstype,int * ier)84 void FSUNSPGMR_SETGSTYPE(int *code, int *gstype, int *ier)
85 {
86 *ier = 0;
87
88 switch(*code) {
89 case FCMIX_CVODE:
90 if (!F2C_CVODE_linsol) {
91 *ier = -1;
92 return;
93 }
94 *ier = SUNLinSol_SPGMRSetGSType(F2C_CVODE_linsol, *gstype);
95 break;
96 case FCMIX_IDA:
97 if (!F2C_IDA_linsol) {
98 *ier = -1;
99 return;
100 }
101 *ier = SUNLinSol_SPGMRSetGSType(F2C_IDA_linsol, *gstype);
102 break;
103 case FCMIX_KINSOL:
104 if (!F2C_KINSOL_linsol) {
105 *ier = -1;
106 return;
107 }
108 *ier = SUNLinSol_SPGMRSetGSType(F2C_KINSOL_linsol, *gstype);
109 break;
110 case FCMIX_ARKODE:
111 if (!F2C_ARKODE_linsol) {
112 *ier = -1;
113 return;
114 }
115 *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_linsol, *gstype);
116 break;
117 default:
118 *ier = -1;
119 }
120 }
121
122
FSUNSPGMR_SETPRECTYPE(int * code,int * pretype,int * ier)123 void FSUNSPGMR_SETPRECTYPE(int *code, int *pretype, int *ier)
124 {
125 *ier = 0;
126
127 switch(*code) {
128 case FCMIX_CVODE:
129 if (!F2C_CVODE_linsol) {
130 *ier = -1;
131 return;
132 }
133 *ier = SUNLinSol_SPGMRSetPrecType(F2C_CVODE_linsol, *pretype);
134 break;
135 case FCMIX_IDA:
136 if (!F2C_IDA_linsol) {
137 *ier = -1;
138 return;
139 }
140 *ier = SUNLinSol_SPGMRSetPrecType(F2C_IDA_linsol, *pretype);
141 break;
142 case FCMIX_KINSOL:
143 if (!F2C_KINSOL_linsol) {
144 *ier = -1;
145 return;
146 }
147 *ier = SUNLinSol_SPGMRSetPrecType(F2C_KINSOL_linsol, *pretype);
148 break;
149 case FCMIX_ARKODE:
150 if (!F2C_ARKODE_linsol) {
151 *ier = -1;
152 return;
153 }
154 *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_linsol, *pretype);
155 break;
156 default:
157 *ier = -1;
158 }
159 }
160
161
FSUNSPGMR_SETMAXRS(int * code,int * maxrs,int * ier)162 void FSUNSPGMR_SETMAXRS(int *code, int *maxrs, int *ier)
163 {
164 *ier = 0;
165
166 switch(*code) {
167 case FCMIX_CVODE:
168 if (!F2C_CVODE_linsol) {
169 *ier = -1;
170 return;
171 }
172 *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_CVODE_linsol, *maxrs);
173 break;
174 case FCMIX_IDA:
175 if (!F2C_IDA_linsol) {
176 *ier = -1;
177 return;
178 }
179 *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_IDA_linsol, *maxrs);
180 break;
181 case FCMIX_KINSOL:
182 if (!F2C_KINSOL_linsol) {
183 *ier = -1;
184 return;
185 }
186 *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_KINSOL_linsol, *maxrs);
187 break;
188 case FCMIX_ARKODE:
189 if (!F2C_ARKODE_linsol) {
190 *ier = -1;
191 return;
192 }
193 *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_linsol, *maxrs);
194 break;
195 default:
196 *ier = -1;
197 }
198 }
199
200
FSUNMASSSPGMR_INIT(int * pretype,int * maxl,int * ier)201 void FSUNMASSSPGMR_INIT(int *pretype, int *maxl, int *ier)
202 {
203 *ier = 0;
204 if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol);
205 F2C_ARKODE_mass_sol = NULL;
206 F2C_ARKODE_mass_sol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl);
207 if (F2C_ARKODE_mass_sol == NULL) *ier = -1;
208 }
209
210
FSUNMASSSPGMR_SETGSTYPE(int * gstype,int * ier)211 void FSUNMASSSPGMR_SETGSTYPE(int *gstype, int *ier)
212 {
213 *ier = 0;
214 if (!F2C_ARKODE_mass_sol) {
215 *ier = -1;
216 return;
217 }
218 *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_mass_sol, *gstype);
219 }
220
221
FSUNMASSSPGMR_SETPRECTYPE(int * pretype,int * ier)222 void FSUNMASSSPGMR_SETPRECTYPE(int *pretype, int *ier)
223 {
224 *ier = 0;
225 if (!F2C_ARKODE_mass_sol) {
226 *ier = -1;
227 return;
228 }
229 *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_mass_sol, *pretype);
230 }
231
232
FSUNMASSSPGMR_SETMAXRS(int * maxrs,int * ier)233 void FSUNMASSSPGMR_SETMAXRS(int *maxrs, int *ier)
234 {
235 *ier = 0;
236 if (!F2C_ARKODE_mass_sol) {
237 *ier = -1;
238 return;
239 }
240 *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_mass_sol, *maxrs);
241 }
242