1 |
C $Header: /u/gcmpack/MITgcm/pkg/openad/externalDummies.F,v 1.9 2016/08/20 03:10:02 heimbach Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "OPENAD_OPTIONS.h" |
5 |
#ifdef ALLOW_STREAMICE |
6 |
#include "STREAMICE_OPTIONS.h" |
7 |
#endif |
8 |
|
9 |
C ########################################################### |
10 |
SUBROUTINE DUMMY_IN_STEPPING( myTime, myIter, myThid ) |
11 |
|
12 |
IMPLICIT NONE |
13 |
#include "SIZE.h" |
14 |
#include "EEPARAMS.h" |
15 |
#include "PARAMS.h" |
16 |
#include "DYNVARS.h" |
17 |
_RL myTime |
18 |
INTEGER myIter |
19 |
INTEGER myThid |
20 |
C dummy self dependence (nontrivial so mfef90 doesn't kill it) |
21 |
theta(1,1,1,1,1)=2*theta(1,1,1,1,1) |
22 |
end subroutine |
23 |
C ########################################################### |
24 |
SUBROUTINE EXCH1_RL( |
25 |
U array, |
26 |
I myOLw, myOLe, myOLs, myOLn, myNz, |
27 |
I exchWidthX, exchWidthY, |
28 |
I cornerMode, myThid ) |
29 |
|
30 |
IMPLICIT NONE |
31 |
#include "SIZE.h" |
32 |
#include "EEPARAMS.h" |
33 |
#include "EXCH.h" |
34 |
INTEGER myOLw, myOLe, myOLs, myOLn, myNz |
35 |
_RL array( 1-myOLw:sNx+myOLe, |
36 |
& 1-myOLs:sNy+myOLn, |
37 |
& myNz, nSx, nSy ) |
38 |
INTEGER exchWidthX |
39 |
INTEGER exchWidthY |
40 |
INTEGER cornerMode |
41 |
INTEGER myThid |
42 |
C dummy self dependence (nontrivial so mfef90 doesn't kill it) |
43 |
array(1,1,1,1,1)=2*array(1,1,1,1,1) |
44 |
end subroutine |
45 |
C ########################################################### |
46 |
C SUBROUTINE EXCH1_RS( |
47 |
C U array, |
48 |
C I myOLw, myOLe, myOLs, myOLn, myNz, |
49 |
C I exchWidthX, exchWidthY, |
50 |
C I cornerMode, myThid ) |
51 |
C |
52 |
C IMPLICIT NONE |
53 |
C#include "SIZE.h" |
54 |
C#include "EEPARAMS.h" |
55 |
C#include "EXCH.h" |
56 |
C INTEGER myOLw, myOLe, myOLs, myOLn, myNz |
57 |
C _RS array( 1-myOLw:sNx+myOLe, |
58 |
C & 1-myOLs:sNy+myOLn, |
59 |
C & myNz, nSx, nSy ) |
60 |
C INTEGER exchWidthX |
61 |
C INTEGER exchWidthY |
62 |
C INTEGER cornerMode |
63 |
C INTEGER myThid |
64 |
C end subroutine |
65 |
C ########################################################### |
66 |
C SUBROUTINE GLOBAL_MAX_R8( |
67 |
C U maxphi, |
68 |
C I myThid ) |
69 |
C IMPLICIT NONE |
70 |
C#include "SIZE.h" |
71 |
C#include "EEPARAMS.h" |
72 |
C#include "EESUPPORT.h" |
73 |
C#include "EXCH.h" |
74 |
C Real*8 maxPhi |
75 |
C INTEGER myThid |
76 |
C maxPhi=2*maxPhi |
77 |
C end subroutine |
78 |
C ########################################################### |
79 |
C SUBROUTINE GLOBAL_SUM_R8( |
80 |
C U sumphi, |
81 |
C I myThid ) |
82 |
C IMPLICIT NONE |
83 |
C#include "SIZE.h" |
84 |
C#include "EEPARAMS.h" |
85 |
C#include "EESUPPORT.h" |
86 |
C#include "EXCH.h" |
87 |
C Real*8 sumPhi |
88 |
C INTEGER myThid |
89 |
CC dummy self dependence (nontrivial so mfef90 doesn't kill it) |
90 |
C sumPhi=2*sumPhi |
91 |
C end subroutine |
92 |
C ########################################################### |
93 |
SUBROUTINE GLOBAL_SUM_TILE_RL( |
94 |
U phiTile, |
95 |
U sumphi, |
96 |
I myThid ) |
97 |
IMPLICIT NONE |
98 |
#include "SIZE.h" |
99 |
#include "EEPARAMS.h" |
100 |
#include "EESUPPORT.h" |
101 |
#include "EXCH.h" |
102 |
_RL phiTile(nSx,nSy) |
103 |
_RL sumPhi |
104 |
INTEGER myThid |
105 |
C dummy self dependence (nontrivial so mfef90 doesn't kill it) |
106 |
sumPhi=2*phiTile(1,1) |
107 |
end subroutine |
108 |
C ########################################################### |
109 |
#ifndef ALLOW_STREAMICE |
110 |
SUBROUTINE CG2D( |
111 |
I cg2d_b, |
112 |
U cg2d_x, |
113 |
O firstResidual, |
114 |
O minResidualSq, |
115 |
O lastResidual, |
116 |
U numIters, |
117 |
O nIterMin, |
118 |
I myThid ) |
119 |
IMPLICIT NONE |
120 |
#include "SIZE.h" |
121 |
#include "EEPARAMS.h" |
122 |
#include "PARAMS.h" |
123 |
#include "CG2D.h" |
124 |
Real*8 cg2d_b(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
125 |
Real*8 cg2d_x(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
126 |
Real*8 firstResidual |
127 |
Real*8 minResidualSq |
128 |
Real*8 lastResidual |
129 |
INTEGER numIters |
130 |
INTEGER nIterMin |
131 |
INTEGER myThid |
132 |
C dummy self dependence (nontrivial so mfef90 doesn't kill it) |
133 |
cg2d_x(1,1,1,1)=2*cg2d_b(1,1,1,1) |
134 |
end subroutine |
135 |
#endif |
136 |
C ########################################################### |
137 |
#ifdef ALLOW_STREAMICE |
138 |
SUBROUTINE STREAMICE_CG_SOLVE( |
139 |
U cg_Uin, ! x-velocities |
140 |
U cg_Vin, ! y-velocities |
141 |
I cg_Bu, ! force in x dir |
142 |
I cg_Bv, ! force in y dir |
143 |
I A_uu, ! section of matrix that multiplies u and projects on u |
144 |
I A_uv, ! section of matrix that multiplies v and projects on u |
145 |
I A_vu, ! section of matrix that multiplies u and projects on v |
146 |
I A_vv, ! section of matrix that multiplies v and projects on v |
147 |
I tolerance, |
148 |
O iters, |
149 |
I maxiter, |
150 |
I myThid ) |
151 |
IMPLICIT NONE |
152 |
|
153 |
#include "SIZE.h" |
154 |
#include "EEPARAMS.h" |
155 |
#include "PARAMS.h" |
156 |
#include "STREAMICE.h" |
157 |
#include "STREAMICE_CG.h" |
158 |
INTEGER myThid |
159 |
INTEGER iters |
160 |
INTEGER maxiter |
161 |
_RL tolerance |
162 |
_RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
163 |
_RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
164 |
_RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
165 |
_RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
166 |
_RL |
167 |
& A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1), |
168 |
& A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1), |
169 |
& A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1), |
170 |
& A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1) |
171 |
|
172 |
cg_Uin(1,1,1,1) = A_uu(1,1,1,1,1,1) + A_uv(1,1,1,1,1,1) + |
173 |
& A_vu(1,1,1,1,1,1) + A_vv(1,1,1,1,1,1) + cg_Bu(1,1,1,1) |
174 |
|
175 |
cg_Vin(1,1,1,1) = A_uu(1,1,1,1,1,1) + A_uv(1,1,1,1,1,1) + |
176 |
& A_vu(1,1,1,1,1,1) + A_vv(1,1,1,1,1,1) + cg_Bv(1,1,1,1) |
177 |
|
178 |
end subroutine |
179 |
#endif /* ALLOW_STREAMICE */ |
180 |
C ########################################################### |
181 |
#ifdef ALLOW_STREAMICE |
182 |
SUBROUTINE STREAMICE_INVERT_SURF_FORTHICK ( |
183 |
O H, |
184 |
I s, |
185 |
I R, |
186 |
I delta, |
187 |
I myThid) |
188 |
|
189 |
#include "SIZE.h" |
190 |
#include "GRID.h" |
191 |
#include "SET_GRID.h" |
192 |
#include "EEPARAMS.h" |
193 |
#include "PARAMS.h" |
194 |
#include "STREAMICE.h" |
195 |
|
196 |
_RL H(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
197 |
_RL S(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
198 |
_RL R(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
199 |
_RL DELTA |
200 |
INTEGER myThid |
201 |
#ifdef STREAMICE_ALLOW_DEPTH_CONTROL |
202 |
H(1,1,1,1) = s(1,1,1,1) + |
203 |
& R(1,1,1,1) |
204 |
#endif |
205 |
|
206 |
end subroutine |
207 |
#endif /* ALLOW_STREAMICE */ |
208 |
C ########################################################### |
209 |
#ifdef ALLOW_STREAMICE |
210 |
SUBROUTINE STREAMICE_SMOOTH_ADJOINT_FIELD ( |
211 |
O X, |
212 |
I myThid) |
213 |
|
214 |
#include "SIZE.h" |
215 |
#include "GRID.h" |
216 |
#include "EEPARAMS.h" |
217 |
|
218 |
_RL X(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
219 |
INTEGER myThid |
220 |
|
221 |
INTEGER i, j, bi, bj, k |
222 |
_RL q_int1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
223 |
_RL q_int2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
224 |
|
225 |
DO bj = myByLo(myThid), myByHi(myThid) |
226 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
227 |
DO j=1-OLy,sNy+OLy |
228 |
DO i=1-OLx,sNx+OLx |
229 |
|
230 |
q_int1(i,j,bi,bj) = 0.0 |
231 |
q_int2(i,j,bi,bj) = 0.0 |
232 |
X(i,j,bi,bj) = X(i,j,bi,bj) * 1.0 |
233 |
k=0 |
234 |
ENDDO |
235 |
ENDDO |
236 |
ENDDO |
237 |
ENDDO |
238 |
|
239 |
|
240 |
end subroutine |
241 |
#endif /* ALLOW_STREAMICE */ |
242 |
C ########################################################### |
243 |
subroutine active_read_xyz( |
244 |
I active_var_file, |
245 |
O active_var, |
246 |
I iRec, |
247 |
I doglobalread, |
248 |
I lAdInit, |
249 |
I myOptimIter, |
250 |
I myThid, |
251 |
I dummy |
252 |
& ) |
253 |
! xxx template ad_template.active_read_xyz.f90 |
254 |
implicit none |
255 |
! == global variables == |
256 |
#include "EEPARAMS.h" |
257 |
#include "SIZE.h" |
258 |
CHARACTER*(80) active_var_file |
259 |
_RL active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) |
260 |
INTEGER iRec |
261 |
INTEGER myOptimIter |
262 |
INTEGER myThid |
263 |
LOGICAL doglobalread |
264 |
LOGICAL lAdInit |
265 |
_RL dummy |
266 |
#ifdef ALLOW_OPENAD_ACTIVE_READ_XYZ |
267 |
active_var = dummy + active_var |
268 |
dummy = active_var(1,1,1,1,1) + dummy |
269 |
#endif /* ALLOW_OPENAD_ACTIVE_READ_XYZ */ |
270 |
end subroutine |
271 |
C ########################################################### |
272 |
subroutine active_read_xy( |
273 |
I active_var_file, |
274 |
O active_var, |
275 |
I iRec, |
276 |
I doglobalread, |
277 |
I lAdInit, |
278 |
I myOptimIter, |
279 |
I myThid, |
280 |
I dummy |
281 |
& ) |
282 |
! xxx template ad_template.active_read_xy.f90 |
283 |
implicit none |
284 |
! == global variables == |
285 |
#include "EEPARAMS.h" |
286 |
#include "SIZE.h" |
287 |
CHARACTER*(80) active_var_file |
288 |
_RL active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
289 |
INTEGER iRec |
290 |
INTEGER myOptimIter |
291 |
INTEGER myThid |
292 |
LOGICAL doglobalread |
293 |
LOGICAL lAdInit |
294 |
_RL dummy |
295 |
#ifdef ALLOW_OPENAD_ACTIVE_READ_XY |
296 |
active_var = dummy + active_var |
297 |
dummy = active_var(1,1,1,1) + dummy |
298 |
#endif /* ALLOW_OPENAD_ACTIVE_READ_XY */ |
299 |
end subroutine |
300 |
C ########################################################### |
301 |
subroutine active_write_xy( |
302 |
I active_var_file, |
303 |
I active_var, |
304 |
I iRec, |
305 |
I myOptimIter, |
306 |
I myThid, |
307 |
I dummy |
308 |
& ) |
309 |
! xxx template ad_template.active_write_xy.f90 |
310 |
implicit none |
311 |
! == global variables == |
312 |
#include "EEPARAMS.h" |
313 |
#include "SIZE.h" |
314 |
CHARACTER*(80) active_var_file |
315 |
_RL active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
316 |
INTEGER iRec |
317 |
INTEGER myOptimIter |
318 |
INTEGER myThid |
319 |
_RL dummy |
320 |
#ifdef ALLOW_OPENAD_ACTIVE_WRITE |
321 |
active_var = dummy + active_var |
322 |
dummy = active_var(1,1,1,1) + dummy |
323 |
#endif /* ALLOW_OPENAD_ACTIVE_WRITE */ |
324 |
end subroutine |
325 |
C ########################################################### |
326 |
|