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_spbcgs.h) contains the
16 * implementation needed for the Fortran initialization of SPBCGS
17 * linear solver operations.
18 * -----------------------------------------------------------------
19 */
20
21 #include <stdio.h>
22 #include <stdlib.h>
23
24 #include "fsunlinsol_spbcgs.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
FSUNSPBCGS_INIT(int * code,int * pretype,int * maxl,int * ier)49 void FSUNSPBCGS_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_SPBCGS(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_SPBCGS(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_SPBCGS(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_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl);
76 if (F2C_ARKODE_linsol == NULL) *ier = -1;
77 break;
78 default:
79 *ier = -1;
80 }
81 }
82
83
FSUNSPBCGS_SETPRECTYPE(int * code,int * pretype,int * ier)84 void FSUNSPBCGS_SETPRECTYPE(int *code, int *pretype, 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_SPBCGSSetPrecType(F2C_CVODE_linsol, *pretype);
95 break;
96 case FCMIX_IDA:
97 if (!F2C_IDA_linsol) {
98 *ier = -1;
99 return;
100 }
101 *ier = SUNLinSol_SPBCGSSetPrecType(F2C_IDA_linsol, *pretype);
102 break;
103 case FCMIX_KINSOL:
104 if (!F2C_KINSOL_linsol) {
105 *ier = -1;
106 return;
107 }
108 *ier = SUNLinSol_SPBCGSSetPrecType(F2C_KINSOL_linsol, *pretype);
109 break;
110 case FCMIX_ARKODE:
111 if (!F2C_ARKODE_linsol) {
112 *ier = -1;
113 return;
114 }
115 *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_linsol, *pretype);
116 break;
117 default:
118 *ier = -1;
119 }
120 }
121
122
FSUNSPBCGS_SETMAXL(int * code,int * maxl,int * ier)123 void FSUNSPBCGS_SETMAXL(int *code, int *maxl, 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_SPBCGSSetMaxl(F2C_CVODE_linsol, *maxl);
134 break;
135 case FCMIX_IDA:
136 if (!F2C_IDA_linsol) {
137 *ier = -1;
138 return;
139 }
140 *ier = SUNLinSol_SPBCGSSetMaxl(F2C_IDA_linsol, *maxl);
141 break;
142 case FCMIX_KINSOL:
143 if (!F2C_KINSOL_linsol) {
144 *ier = -1;
145 return;
146 }
147 *ier = SUNLinSol_SPBCGSSetMaxl(F2C_KINSOL_linsol, *maxl);
148 break;
149 case FCMIX_ARKODE:
150 if (!F2C_ARKODE_linsol) {
151 *ier = -1;
152 return;
153 }
154 *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_linsol, *maxl);
155 break;
156 default:
157 *ier = -1;
158 }
159 }
160
161
FSUNMASSSPBCGS_INIT(int * pretype,int * maxl,int * ier)162 void FSUNMASSSPBCGS_INIT(int *pretype, int *maxl, int *ier)
163 {
164 *ier = 0;
165 if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol);
166 F2C_ARKODE_mass_sol = NULL;
167 F2C_ARKODE_mass_sol = SUNLinSol_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl);
168 if (F2C_ARKODE_mass_sol == NULL) *ier = -1;
169 }
170
171
FSUNMASSSPBCGS_SETPRECTYPE(int * pretype,int * ier)172 void FSUNMASSSPBCGS_SETPRECTYPE(int *pretype, int *ier)
173 {
174 *ier = 0;
175 if (!F2C_ARKODE_mass_sol) {
176 *ier = -1;
177 return;
178 }
179 *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_mass_sol, *pretype);
180 }
181
182
FSUNMASSSPBCGS_SETMAXL(int * maxl,int * ier)183 void FSUNMASSSPBCGS_SETMAXL(int *maxl, int *ier)
184 {
185 *ier = 0;
186 if (!F2C_ARKODE_mass_sol) {
187 *ier = -1;
188 return;
189 }
190 *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_mass_sol, *maxl);
191 }
192