/[MITgcm]/MITgcm/pkg/obcs/obcs_init_variables.F
ViewVC logotype

Contents of /MITgcm/pkg/obcs/obcs_init_variables.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.26 - (show annotations) (download)
Tue Apr 28 18:18:29 2009 UTC (15 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61n, checkpoint61q, checkpoint61o, checkpoint61m, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p
Changes since 1.25: +3 -3 lines
change macros (EXCH & GLOBAL_SUM/MAX) sufix _R4/_R8 to _RS/_RL
 when applied to _RS/_RL variable

1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_init_variables.F,v 1.25 2007/11/13 23:39:25 dimitri Exp $
2 C $Name: $
3
4 #include "OBCS_OPTIONS.h"
5
6 SUBROUTINE OBCS_INIT_VARIABLES( myThid )
7 C /==========================================================\
8 C | SUBROUTINE OBCS_INIT_VARIABLES |
9 C | o Initialise OBCs variable data |
10 C |==========================================================|
11 C | |
12 C \==========================================================/
13 IMPLICIT NONE
14
15 C === Global variables ===
16 #include "SIZE.h"
17 #include "EEPARAMS.h"
18 #include "PARAMS.h"
19 #include "DYNVARS.h"
20 #include "OBCS.h"
21 #ifdef ALLOW_PTRACERS
22 #include "PTRACERS_SIZE.h"
23 #include "PTRACERS_PARAMS.h"
24 #include "PTRACERS_FIELDS.h"
25 #include "OBCS_PTRACERS.h"
26 #endif /* ALLOW_PTRACERS */
27
28 C == Routine arguments ==
29 C myThid - Number of this instance of INI_DEPTHS
30 INTEGER myThid
31
32 #ifdef ALLOW_OBCS
33
34 C == Local variables ==
35 INTEGER bi, bj
36 INTEGER I, J, K
37 CHARACTER*(10) suff
38 INTEGER prec
39 #ifdef ALLOW_PTRACERS
40 INTEGER iTracer
41 #endif /* ALLOW_PTRACERS */
42
43 #ifdef ALLOW_DEBUG
44 IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_VARIABLES',myThid)
45 #endif
46
47 DO bj = myByLo(myThid), myByHi(myThid)
48 DO bi = myBxLo(myThid), myBxHi(myThid)
49
50 DO K=1,Nr
51 DO I=1-Olx,sNx+Olx
52 #ifdef ALLOW_OBCS_NORTH
53 OBNu(I,K,bi,bj)=0. _d 0
54 OBNv(I,K,bi,bj)=0. _d 0
55 OBNt(I,K,bi,bj)=0. _d 0
56 OBNs(I,K,bi,bj)=0. _d 0
57 # ifdef ALLOW_NONHYDROSTATIC
58 OBNw(I,K,bi,bj)=0. _d 0
59 # endif
60 # ifdef ALLOW_OBCS_PRESCRIBE
61 OBNu0(I,K,bi,bj)=0. _d 0
62 OBNv0(I,K,bi,bj)=0. _d 0
63 OBNt0(I,K,bi,bj)=0. _d 0
64 OBNs0(I,K,bi,bj)=0. _d 0
65 OBNu1(I,K,bi,bj)=0. _d 0
66 OBNv1(I,K,bi,bj)=0. _d 0
67 OBNt1(I,K,bi,bj)=0. _d 0
68 OBNs1(I,K,bi,bj)=0. _d 0
69 # endif
70 #endif /* ALLOW_OBCS_NORTH */
71
72 #ifdef ALLOW_OBCS_SOUTH
73 OBSu(I,K,bi,bj)=0. _d 0
74 OBSv(I,K,bi,bj)=0. _d 0
75 OBSt(I,K,bi,bj)=0. _d 0
76 OBSs(I,K,bi,bj)=0. _d 0
77 # ifdef ALLOW_NONHYDROSTATIC
78 OBSw(I,K,bi,bj)=0. _d 0
79 # endif
80 # ifdef ALLOW_OBCS_PRESCRIBE
81 OBSu0(I,K,bi,bj)=0. _d 0
82 OBSv0(I,K,bi,bj)=0. _d 0
83 OBSt0(I,K,bi,bj)=0. _d 0
84 OBSs0(I,K,bi,bj)=0. _d 0
85 OBSu1(I,K,bi,bj)=0. _d 0
86 OBSv1(I,K,bi,bj)=0. _d 0
87 OBSt1(I,K,bi,bj)=0. _d 0
88 OBSs1(I,K,bi,bj)=0. _d 0
89 # endif
90 #endif /* ALLOW_OBCS_SOUTH */
91 ENDDO
92
93 DO J=1-Oly,sNy+Oly
94 #ifdef ALLOW_OBCS_EAST
95 OBEu(J,K,bi,bj)=0. _d 0
96 OBEv(J,K,bi,bj)=0. _d 0
97 OBEt(J,K,bi,bj)=0. _d 0
98 OBEs(J,K,bi,bj)=0. _d 0
99 # ifdef ALLOW_NONHYDROSTATIC
100 OBEw(J,K,bi,bj)=0. _d 0
101 # endif
102 # ifdef ALLOW_OBCS_PRESCRIBE
103 OBEu0(J,K,bi,bj)=0. _d 0
104 OBEv0(J,K,bi,bj)=0. _d 0
105 OBEt0(J,K,bi,bj)=0. _d 0
106 OBEs0(J,K,bi,bj)=0. _d 0
107 OBEu1(J,K,bi,bj)=0. _d 0
108 OBEv1(J,K,bi,bj)=0. _d 0
109 OBEt1(J,K,bi,bj)=0. _d 0
110 OBEs1(J,K,bi,bj)=0. _d 0
111 # endif
112 #endif /* ALLOW_OBCS_EAST */
113
114 #ifdef ALLOW_OBCS_WEST
115 OBWu(J,K,bi,bj)=0. _d 0
116 OBWv(J,K,bi,bj)=0. _d 0
117 OBWt(J,K,bi,bj)=0. _d 0
118 OBWs(J,K,bi,bj)=0. _d 0
119 # ifdef ALLOW_NONHYDROSTATIC
120 OBWw(J,K,bi,bj)=0. _d 0
121 # endif
122 # ifdef ALLOW_OBCS_PRESCRIBE
123 OBWu0(J,K,bi,bj)=0. _d 0
124 OBWv0(J,K,bi,bj)=0. _d 0
125 OBWt0(J,K,bi,bj)=0. _d 0
126 OBWs0(J,K,bi,bj)=0. _d 0
127 OBWu1(J,K,bi,bj)=0. _d 0
128 OBWv1(J,K,bi,bj)=0. _d 0
129 OBWt1(J,K,bi,bj)=0. _d 0
130 OBWs1(J,K,bi,bj)=0. _d 0
131 # endif
132 #endif /* ALLOW_OBCS_WEST */
133 ENDDO
134 ENDDO
135
136 #ifdef ALLOW_SEAICE
137 DO I=1-Olx,sNx+Olx
138 #ifdef ALLOW_OBCS_NORTH
139 OBNa (I,bi,bj)=0. _d 0
140 OBNh (I,bi,bj)=0. _d 0
141 OBNa0(I,bi,bj)=0. _d 0
142 OBNh0(I,bi,bj)=0. _d 0
143 OBNa1(I,bi,bj)=0. _d 0
144 OBNh1(I,bi,bj)=0. _d 0
145 OBNsl (I,bi,bj)=0. _d 0
146 OBNsn (I,bi,bj)=0. _d 0
147 OBNsl0(I,bi,bj)=0. _d 0
148 OBNsn0(I,bi,bj)=0. _d 0
149 OBNsl1(I,bi,bj)=0. _d 0
150 OBNsn1(I,bi,bj)=0. _d 0
151 OBNuice (I,bi,bj)=0. _d 0
152 OBNvice (I,bi,bj)=0. _d 0
153 OBNuice0(I,bi,bj)=0. _d 0
154 OBNvice0(I,bi,bj)=0. _d 0
155 OBNuice1(I,bi,bj)=0. _d 0
156 OBNvice1(I,bi,bj)=0. _d 0
157 #endif /* ALLOW_OBCS_NORTH */
158 #ifdef ALLOW_OBCS_SOUTH
159 OBSa (I,bi,bj)=0. _d 0
160 OBSh (I,bi,bj)=0. _d 0
161 OBSa0(I,bi,bj)=0. _d 0
162 OBSh0(I,bi,bj)=0. _d 0
163 OBSa1(I,bi,bj)=0. _d 0
164 OBSh1(I,bi,bj)=0. _d 0
165 OBSsl (I,bi,bj)=0. _d 0
166 OBSsn (I,bi,bj)=0. _d 0
167 OBSsl0(I,bi,bj)=0. _d 0
168 OBSsn0(I,bi,bj)=0. _d 0
169 OBSsl1(I,bi,bj)=0. _d 0
170 OBSsn1(I,bi,bj)=0. _d 0
171 OBSuice (I,bi,bj)=0. _d 0
172 OBSvice (I,bi,bj)=0. _d 0
173 OBSuice0(I,bi,bj)=0. _d 0
174 OBSvice0(I,bi,bj)=0. _d 0
175 OBSuice1(I,bi,bj)=0. _d 0
176 OBSvice1(I,bi,bj)=0. _d 0
177 #endif /* ALLOW_OBCS_SOUTH */
178 ENDDO
179 DO J=1-Oly,sNy+Oly
180 #ifdef ALLOW_OBCS_EAST
181 OBEa (J,bi,bj)=0. _d 0
182 OBEh (J,bi,bj)=0. _d 0
183 OBEa0(J,bi,bj)=0. _d 0
184 OBEh0(J,bi,bj)=0. _d 0
185 OBEa1(J,bi,bj)=0. _d 0
186 OBEh1(J,bi,bj)=0. _d 0
187 OBEsl (J,bi,bj)=0. _d 0
188 OBEsn (J,bi,bj)=0. _d 0
189 OBEsl0(J,bi,bj)=0. _d 0
190 OBEsn0(J,bi,bj)=0. _d 0
191 OBEsl1(J,bi,bj)=0. _d 0
192 OBEsn1(J,bi,bj)=0. _d 0
193 OBEuice (J,bi,bj)=0. _d 0
194 OBEvice (J,bi,bj)=0. _d 0
195 OBEuice0(J,bi,bj)=0. _d 0
196 OBEvice0(J,bi,bj)=0. _d 0
197 OBEuice1(J,bi,bj)=0. _d 0
198 OBEvice1(J,bi,bj)=0. _d 0
199 #endif /* ALLOW_OBCS_EAST */
200 #ifdef ALLOW_OBCS_WEST
201 OBWa (J,bi,bj)=0. _d 0
202 OBWh (J,bi,bj)=0. _d 0
203 OBWa0(J,bi,bj)=0. _d 0
204 OBWh0(J,bi,bj)=0. _d 0
205 OBWa1(J,bi,bj)=0. _d 0
206 OBWh1(J,bi,bj)=0. _d 0
207 OBWsl (J,bi,bj)=0. _d 0
208 OBWsn (J,bi,bj)=0. _d 0
209 OBWsl0(J,bi,bj)=0. _d 0
210 OBWsn0(J,bi,bj)=0. _d 0
211 OBWsl1(J,bi,bj)=0. _d 0
212 OBWsn1(J,bi,bj)=0. _d 0
213 OBWuice (J,bi,bj)=0. _d 0
214 OBWvice (J,bi,bj)=0. _d 0
215 OBWuice0(J,bi,bj)=0. _d 0
216 OBWvice0(J,bi,bj)=0. _d 0
217 OBWuice1(J,bi,bj)=0. _d 0
218 OBWvice1(J,bi,bj)=0. _d 0
219 #endif /* ALLOW_OBCS_WEST */
220 ENDDO
221 #endif /* ALLOW_SEAICE */
222
223 #ifdef ALLOW_PTRACERS
224 #ifndef ALLOW_AUTODIFF_TAMC
225 IF ( usePTRACERS ) THEN
226 #endif
227 DO iTracer=1,PTRACERS_numInUse
228 DO K=1,Nr
229 DO I=1-Olx,sNx+Olx
230 #ifdef ALLOW_OBCS_NORTH
231 OBNptr (I,K,bi,bj,iTracer)=0. _d 0
232 # ifdef ALLOW_OBCS_PRESCRIBE
233 OBNptr0(I,K,bi,bj,iTracer)=0. _d 0
234 OBNptr1(I,K,bi,bj,iTracer)=0. _d 0
235 # endif
236 #endif /* ALLOW_OBCS_NORTH */
237
238 #ifdef ALLOW_OBCS_SOUTH
239 OBSptr (I,K,bi,bj,iTracer)=0. _d 0
240 # ifdef ALLOW_OBCS_PRESCRIBE
241 OBSptr0(I,K,bi,bj,iTracer)=0. _d 0
242 OBSptr1(I,K,bi,bj,iTracer)=0. _d 0
243 # endif
244 #endif /* ALLOW_OBCS_SOUTH */
245 ENDDO
246
247 DO J=1-Oly,sNy+Oly
248 #ifdef ALLOW_OBCS_EAST
249 OBEptr (J,K,bi,bj,iTracer)=0. _d 0
250 # ifdef ALLOW_OBCS_PRESCRIBE
251 OBEptr0(J,K,bi,bj,iTracer)=0. _d 0
252 OBEptr1(J,K,bi,bj,iTracer)=0. _d 0
253 # endif
254 #endif /* ALLOW_OBCS_EAST */
255
256 #ifdef ALLOW_OBCS_WEST
257 OBWptr (J,K,bi,bj,iTracer)=0. _d 0
258 # ifdef ALLOW_OBCS_PRESCRIBE
259 OBWptr0(J,K,bi,bj,iTracer)=0. _d 0
260 OBWptr1(J,K,bi,bj,iTracer)=0. _d 0
261 # endif
262 #endif /* ALLOW_OBCS_WEST */
263 ENDDO
264 ENDDO
265 ENDDO
266 #ifndef ALLOW_AUTODIFF_TAMC
267 ENDIF
268 #endif
269 #endif /* ALLOW_PTRACERS */
270
271 #ifdef NONLIN_FRSURF
272 DO I=1-Olx,sNx+Olx
273 OBNeta(I,bi,bj)=0.
274 OBSeta(I,bi,bj)=0.
275 ENDDO
276 DO J=1-Oly,sNy+Oly
277 OBEeta(J,bi,bj)=0.
278 OBWeta(J,bi,bj)=0.
279 ENDDO
280 #endif /* NONLIN_FRSURF */
281
282 #ifdef ALLOW_ORLANSKI
283 IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.
284 & useOrlanskiEast.OR.useOrlanskiWest) THEN
285 #ifdef ALLOW_DEBUG
286 IF (debugMode) CALL DEBUG_CALL('ORLANSKI_INIT',myThid)
287 #endif
288 CALL ORLANSKI_INIT(bi, bj, myThid)
289 ENDIF
290 #endif /* ALLOW_ORLANSKI */
291
292 ENDDO
293 ENDDO
294
295 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
296 C jmc: here is the logical place to read OBCS-pickup files
297 C but a) without Orlanski: pass the test 1+1=2 without reading pickup.
298 C b) with Orlanski: 1+1=2 fail even with this bit of code
299 IF ( nIter0.NE.0 ) THEN
300 prec = precFloat64
301 IF (pickupSuff.EQ.' ') THEN
302 WRITE(suff,'(I10.10)') nIter0
303 ELSE
304 WRITE(suff,'(A10)') pickupSuff
305 ENDIF
306 c CALL OBCS_READ_CHECKPOINT(prec, nIter0, suff, myThid)
307 ENDIF
308 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
309
310 C-- Load/compute OBCS values in all cases, although these values are
311 C-- only used for initialisation and never for restart:
312 #ifdef ALLOW_DEBUG
313 IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
314 #endif
315 DO bj = myByLo(myThid), myByHi(myThid)
316 DO bi = myBxLo(myThid), myBxHi(myThid)
317 CALL OBCS_CALC( bi, bj, startTime, nIter0,
318 & uVel, vVel, wVel, theta, salt, myThid )
319 ENDDO
320 ENDDO
321
322 IF ( startTime .EQ. baseTime .AND. nIter0 .EQ. 0
323 & .AND. pickupSuff .EQ. ' ' ) THEN
324 C-- Apply OBCS values to initial conditions for consistency
325 C (but initial conditions only)
326 #ifdef ALLOW_DEBUG
327 IF (debugMode)
328 & CALL DEBUG_CALL('OBCS_APPLY_UV + OBCS_APPLY_TS',myThid)
329 #endif
330 DO bj = myByLo(myThid), myByHi(myThid)
331 DO bi = myBxLo(myThid), myBxHi(myThid)
332 DO K=1,Nr
333 CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )
334 CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )
335 ENDDO
336 ENDDO
337 ENDDO
338 IF (useOBCSprescribe) THEN
339 C After applying the boundary conditions exchange the 3D-fields.
340 C This is only necessary of the boudnary values have been read
341 C from a file.
342 #ifdef ALLOW_DEBUG
343 IF (debugMode)
344 & CALL DEBUG_CALL('EXCHANGES in OBCS_INIT_VARIABLES',myThid)
345 #endif
346 CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
347 _EXCH_XYZ_RL( theta, myThid )
348 _EXCH_XYZ_RL( salt , myThid )
349 ENDIF
350 C endif start from rest
351 ENDIF
352 #ifdef ALLOW_PTRACERS
353 C repeat everything for passive tracers
354 IF ( usePTRACERS ) THEN
355 C catch the case when we do start from a pickup for dynamics variables
356 C but initialise ptracers differently
357 IF ( nIter0 .EQ. PTRACERS_Iter0 ) THEN
358 #ifdef ALLOW_DEBUG
359 IF (debugMode)
360 & CALL DEBUG_CALL('OBCS_APPLY_PTRACER',myThid)
361 #endif
362 DO iTracer=1,PTRACERS_numInUse
363 DO bj = myByLo(myThid), myByHi(myThid)
364 DO bi = myBxLo(myThid), myBxHi(myThid)
365 DO K=1,Nr
366 CALL OBCS_APPLY_PTRACER(
367 I bi, bj, K, iTracer,
368 U ptracer(1-Olx,1-Oly,K,bi,bj,iTracer),
369 I myThid )
370 ENDDO
371 ENDDO
372 ENDDO
373 ENDDO
374 IF (useOBCSprescribe) THEN
375 C After applying the boundary conditions exchange the 3D-fields.
376 C This is only necessary of the boudnary values have been read
377 C from a file.
378 #ifdef ALLOW_DEBUG
379 IF (debugMode) CALL DEBUG_CALL(
380 & 'PTRACERS EXCHANGES in OBCS_INIT_VARIABLES',myThid)
381 #endif
382 CALL PTRACERS_FIELDS_BLOCKING_EXCH( myThid )
383 ENDIF
384 C endif start from rest
385 ENDIF
386 C endif usePTRACERS
387 ENDIF
388 #endif /* ALLOW_PTRACERS */
389
390 #endif /* ALLOW_OBCS */
391
392 #ifdef ALLOW_DEBUG
393 IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_VARIABLES',myThid)
394 #endif
395 RETURN
396 END

  ViewVC Help
Powered by ViewVC 1.1.22