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