adve_orig.h
References to this file elsewhere.
1 !***********************************************************************
2 SUBROUTINE ADVE(NTSD,DT,DETA1,DETA2,PDTOP &
3 & ,CURV,F,FAD,F4D,EM_LOC,EMT_LOC,EN,ENT,DX,DY &
4 & ,HTM,HBM2,VTM,VBM2,LMH,LMV &
5 & ,T,U,V,PDSLO,TOLD,UOLD,VOLD &
6 & ,PETDT,UPSTRM &
7 & ,FEW,FNS,FNE,FSE &
8 & ,ADT,ADU,ADV &
9 & ,N_IUP_H,N_IUP_V &
10 & ,N_IUP_ADH,N_IUP_ADV &
11 & ,IUP_H,IUP_V,IUP_ADH,IUP_ADV &
12 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
13 & ,IDS,IDE,JDS,JDE,KDS,KDE &
14 & ,IMS,IME,JMS,JME,KMS,KME &
15 & ,ITS,ITE,JTS,JTE,KTS,KTE)
16 !***********************************************************************
17 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
18 ! . . .
19 ! SUBPROGRAM: ADVE HORIZONTAL AND VERTICAL ADVECTION
20 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-10-28
21 !
22 ! ABSTRACT:
23 ! ADVE CALCULATES THE CONTRIBUTION OF THE HORIZONTAL AND VERTICAL
24 ! ADVECTION TO THE TENDENCIES OF TEMPERATURE AND WIND AND THEN
25 ! UPDATES THOSE VARIABLES.
26 ! THE JANJIC ADVECTION SCHEME FOR THE ARAKAWA E GRID IS USED
27 ! FOR ALL VARIABLES INSIDE THE FIFTH ROW. AN UPSTREAM SCHEME
28 ! IS USED ON ALL VARIABLES IN THE THIRD, FOURTH, AND FIFTH
29 ! OUTERMOST ROWS. THE ADAMS-BASHFORTH TIME SCHEME IS USED.
30 !
31 ! PROGRAM HISTORY LOG:
32 ! 87-06-?? JANJIC - ORIGINATOR
33 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
34 ! 96-03-28 BLACK - ADDED EXTERNAL EDGE
35 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
36 ! 99-07- JANJIC - CONVERTED TO ADAMS-BASHFORTH SCHEME
37 ! COMBINING HORIZONTAL AND VERTICAL ADVECTION
38 ! 02-02-04 BLACK - ADDED VERTICAL CFL CHECK
39 ! 02-02-05 BLACK - CONVERTED TO WRF FORMAT
40 ! 02-08-29 MICHALAKES - CONDITIONAL COMPILATION OF MPI
41 ! CONVERT TO GLOBAL INDEXING
42 ! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING
43 ! 04-05-29 JANJIC,BLACK - CRANK-NICHOLSON VERTICAL ADVECTION
44 !
45 ! USAGE: CALL ADVE FROM SUBROUTINE SOLVE_RUNSTREAM
46 ! INPUT ARGUMENT LIST:
47 !
48 ! OUTPUT ARGUMENT LIST:
49 !
50 ! OUTPUT FILES:
51 ! NONE
52 !
53 ! SUBPROGRAMS CALLED:
54 !
55 ! UNIQUE: NONE
56 !
57 ! LIBRARY: NONE
58 !
59 ! ATTRIBUTES:
60 ! LANGUAGE: FORTRAN 90
61 ! MACHINE : IBM SP
62 !$$$
63 !***********************************************************************
64 !-----------------------------------------------------------------------
65 !
66 IMPLICIT NONE
67 !
68 !-----------------------------------------------------------------------
69 !
70 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
71 & ,IMS,IME,JMS,JME,KMS,KME &
72 & ,ITS,ITE,JTS,JTE,KTS,KTE
73 !
74 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
75 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: N_IUP_H,N_IUP_V &
76 & ,N_IUP_ADH,N_IUP_ADV
77 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IUP_H,IUP_V &
78 & ,IUP_ADH,IUP_ADV &
79 & ,LMH,LMV
80 !
81 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
82 !*** the value of dimspec q in the Registry/Registry
83 !
84 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
85 !
86 INTEGER,INTENT(IN) :: NTSD
87 !
88 REAL,INTENT(IN) :: DT,DY,EN,ENT,F4D,PDTOP
89 !
90 REAL,DIMENSION(NMM_MAX_DIM),INTENT(IN) :: EM_LOC,EMT_LOC
91 !
92 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1,DETA2
93 !
94 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CURV,DX,F,FAD,HBM2 &
95 & ,PDSLO,VBM2
96 !
97 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
98 !
99 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
100 !
101 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,TOLD &
102 & ,U,UOLD &
103 & ,V,VOLD
104 !
105 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: ADT,ADU &
106 & ,ADV &
107 & ,FEW,FNE &
108 & ,FNS,FSE
109 !
110 !-----------------------------------------------------------------------
111 !
112 !*** LOCAL VARIABLES
113 !
114 LOGICAL :: UPSTRM
115 !
116 INTEGER :: I,IEND,IFP,IFQ,II,IPQ,ISP,ISQ,ISTART &
117 & ,IUP_ADH_J,IVH,IVL &
118 & ,J,J1,JA,JAK,JEND,JGLOBAL,JJ,JKNT,JP2,JSTART &
119 & ,K,KNTI_ADH,KSTART,KSTOP,LMHK,LMVK &
120 & ,N,N_IUPH_J,N_IUPADH_J,N_IUPADV_J
121 !
122 INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
123 !
124 INTEGER :: J0_P3,J0_P2,J0_P1,J0_00,J0_M1,J1_P2,J1_P1,J1_00,J1_M1 &
125 & ,J2_P1,J2_00,J2_M1,J3_P2,J3_P1,J3_00 &
126 & ,J4_P1,J4_00,J4_M1,J5_00,J5_M1,J6_P1,J6_00
127 !
128 INTEGER,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ISPA,ISQA
129 !
130 REAL :: ARRAY3_X,CFT,CFU,CFV,CMT,CMU,CMV &
131 & ,DPDE_P3,DTE,DTQ &
132 & ,F0,F1,F2,F3,FEW_00,FEW_P1,FNE_X,FNS_P1,FNS_X,FPP,FSE_X &
133 & ,HM,PDOP,PDOPU,PDOPV,PP &
134 & ,PVVLO,PVVLOU,PVVLOV,PVVUP,PVVUPU,PVVUPV &
135 & ,QP,RDP,RDPD,RDPDX,RDPDY,RDPU,RDPV &
136 & ,T_UP,TEMPA,TEMPB,TTA,TTB,U_UP,UDY_P1,UDY_X &
137 & ,VXD_X,VDX_P2,V_UP,VDX_X,VM,VTA,VUA,VVA &
138 & ,VVLO,VVLOU,VVLOV,VVUP,VVUPU,VVUPV
139 !
140 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: ARRAY0,ARRAY1 &
141 & ,ARRAY2,ARRAY3 &
142 & ,VAD_TEND_T,VAD_TEND_U &
143 & ,VAD_TEND_V
144 !
145 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: TEW,UEW,VEW
146 !
147 REAL,DIMENSION(KTS:KTE) :: CRT,CRU,CRV,DETA1_PDTOP &
148 & ,RCMT,RCMU,RCMV,RSTT,RSTU,RSTV,TN,UN &
149 & ,VAD_TNDX_T,VAD_TNDX_U,VAD_TNDX_V,VN
150 !
151 REAL,DIMENSION(ITS-5:ITE+5,-1:1) :: PETDTK
152 !
153 REAL,DIMENSION(ITS-5:ITE+5) :: TDN,UDN,VDN
154 !
155 !-----------------------------------------------------------------------
156 !
157 !*** TYPE 0 WORKING ARRAY
158 !
159 REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-3:3) :: DPDE
160 !
161 !*** TYPE 1 WORKING ARRAY
162 !
163 REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-2:2) :: TST,UDY,UST,VDX,VST
164 !
165 !*** TYPE 4 WORKING ARRAY
166 !
167 REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:1) :: TNS,UNS,VNS
168 !
169 !*** TYPE 5 WORKING ARRAY
170 !
171 REAL,DIMENSION(ITS-5:ITE+5,KMS:KME,-1:0) :: TNE,UNE,VNE
172 !
173 !*** TYPE 6 WORKING ARRAY
174 !
175 REAL,DIMENSION(ITS-5:ITE+5,KMS:KME, 0:1) :: TSE,USE,VSE
176 !-----------------------------------------------------------------------
177 !-----------------------------------------------------------------------
178 !***********************************************************************
179 !
180 ! DPDE ----- 3
181 ! | J Increasing
182 ! |
183 ! | ^
184 ! FNS ----- 2 |
185 ! | |
186 ! | |
187 ! | |
188 ! VNS ----- 1 |
189 ! |
190 ! |
191 ! |
192 ! ADV ----- 0 ------> Current J
193 ! |
194 ! |
195 ! |
196 ! VNS ----- -1
197 ! |
198 ! |
199 ! |
200 ! FNS ----- -2
201 ! |
202 ! |
203 ! |
204 ! DPDE ----- -3
205 !
206 !***********************************************************************
207 !-----------------------------------------------------------------------
208 !-----------------------------------------------------------------------
209 !
210 ISTART=MYIS_P2
211 IEND=MYIE_P2
212 IF(ITE==IDE)IEND=MYIE-3
213 !
214 DTQ=DT*0.25
215 DTE=DT*(0.5*0.25)
216 !***
217 !*** INITIALIZE SOME WORKING ARRAYS TO ZERO
218 !***
219 DO K=KTS,KTE
220 DO I=ITS-5,ITE+5
221 TEW(I,K)=0.
222 UEW(I,K)=0.
223 VEW(I,K)=0.
224 ENDDO
225 ENDDO
226 !
227 !*** TYPE 0
228 !
229 DO N=-3,3
230 DO K=KTS,KTE
231 DO I=ITS-5,ITE+5
232 DPDE(I,K,N)=0.
233 ENDDO
234 ENDDO
235 ENDDO
236 !
237 !*** TYPE 1
238 !
239 DO N=-2,2
240 DO K=KTS,KTE
241 DO I=ITS-5,ITE+5
242 TST(I,K,N)=0.
243 UST(I,K,N)=0.
244 VST(I,K,N)=0.
245 UDY(I,K,N)=0.
246 VDX(I,K,N)=0.
247 ENDDO
248 ENDDO
249 ENDDO
250 !
251 !*** TYPES 5 AND 6
252 !
253 DO N=-1,0
254 DO K=KTS,KTE
255 DO I=ITS-5,ITE+5
256 TNE(I,K,N)=0.
257 TSE(I,K,N+1)=0.
258 UNE(I,K,N)=0.
259 USE(I,K,N+1)=0.
260 VNE(I,K,N)=0.
261 VSE(I,K,N+1)=0.
262 ENDDO
263 ENDDO
264 ENDDO
265 !-----------------------------------------------------------------------
266 !***
267 !*** PRECOMPUTE DETA1 TIMES PDTOP.
268 !***
269 !-----------------------------------------------------------------------
270 !
271 DO K=KTS,KTE
272 DETA1_PDTOP(K)=DETA1(K)*PDTOP
273 ENDDO
274 !-----------------------------------------------------------------------
275 !***
276 !*** WE NEED THE STARTING AND ENDING J FOR THIS TASK'S INTEGRATION
277 !***
278 JSTART=MYJS2
279 JEND=MYJE2
280 !
281 !
282 !-----------------------------------------------------------------------
283 !
284 !*** START THE HORIZONTAL ADVECTION IN THE INITIAL SOUTHERN SLABS.
285 !
286 !-----------------------------------------------------------------------
287 !
288 DO J=-2,1
289 JJ=JSTART+J
290 DO K=KTS,KTE
291 DO I=MYIS_P4,MYIE_P4
292 TST(I,K,J)=T(I,K,JJ)*FFC+TOLD(I,K,JJ)*FBC
293 UST(I,K,J)=U(I,K,JJ)*FFC+UOLD(I,K,JJ)*FBC
294 VST(I,K,J)=V(I,K,JJ)*FFC+VOLD(I,K,JJ)*FBC
295 ENDDO
296 ENDDO
297 ENDDO
298 !
299 !-----------------------------------------------------------------------
300 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
301 !*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
302 !*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
303 !*** ONLY THE NORTHERNMOST OF EACH OF THE WORKING ARRAYS WILL BE
304 !*** FILLED IN THE PRIMARY INTEGRATION SECTION.
305 !-----------------------------------------------------------------------
306 !
307 J1=-3
308 IF(JTS==JDS)J1=-2 ! Cannot go 3 south from J=2 for south tasks
309 !
310 DO J=J1,2
311 JJ=JSTART+J
312 !
313 DO K=KTS,KTE
314 DO I=MYIS_P4,MYIE_P4
315 DPDE(I,K,J)=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,JJ)
316 ENDDO
317 ENDDO
318 !
319 ENDDO
320 !
321 !-----------------------------------------------------------------------
322 DO J=-2,1
323 JJ=JSTART+J
324 !
325 DO K=KTS,KTE
326 DO I=MYIS_P4,MYIE_P4
327 UDY(I,K,J)=U(I,K,JJ)*DY
328 VDX_X=V(I,K,JJ)*DX(I,JJ)
329 FNS(I,K,JJ)=VDX_X*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
330 VDX(I,K,J)=VDX_X
331 ENDDO
332 ENDDO
333 !
334 ENDDO
335 !
336 !-----------------------------------------------------------------------
337 DO J=-2,0
338 JJ=JSTART+J
339 !
340 DO K=KTS,KTE
341 DO I=MYIS_P3,MYIE_P3
342 TEMPA=(UDY(I+IHE(JJ),K,J)+VDX(I+IHE(JJ),K,J)) &
343 & +(UDY(I,K,J+1) +VDX(I,K,J+1))
344 FNE(I,K,JJ)=TEMPA*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
345 ENDDO
346 ENDDO
347 !
348 ENDDO
349 !
350 !-----------------------------------------------------------------------
351 DO J=-1,1
352 JJ=JSTART+J
353 !
354 DO K=KTS,KTE
355 DO I=MYIS_P3,MYIE_P3
356 TEMPB=(UDY(I+IHE(JJ),K,J)-VDX(I+IHE(JJ),K,J)) &
357 & +(UDY(I,K,J-1) -VDX(I,K,J-1))
358 FSE(I,K,JJ)=TEMPB*(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
359 ENDDO
360 ENDDO
361 !
362 ENDDO
363 !
364 !-----------------------------------------------------------------------
365 DO J=-1,0
366 JJ=JSTART+J
367 !
368 DO K=KTS,KTE
369 DO I=MYIS1_P3,MYIE1_P3
370 FNS_X=FNS(I,K,JJ)
371 TNS(I,K,J)=FNS_X*(TST(I,K,J+1)-TST(I,K,J-1))
372 !
373 UDY_X=U(I,K,JJ)*DY
374 FEW(I,K,JJ)=UDY_X*(DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J))
375 ENDDO
376 ENDDO
377 !
378 DO K=KTS,KTE
379 DO I=MYIS1_P4,MYIE1_P4
380 UNS(I,K,J)=(FNS(I+IHW(JJ),K,JJ)+FNS(I+IHE(JJ),K,JJ)) &
381 & *(UST(I,K,J+1)-UST(I,K,J-1))
382 VNS(I,K,J)=(FNS(I,K,JJ-1)+FNS(I,K,JJ+1)) &
383 & *(VST(I,K,J+1)-VST(I,K,J-1))
384 ENDDO
385 ENDDO
386 !
387 ENDDO
388 !
389 !-----------------------------------------------------------------------
390 JJ=JSTART-1
391 !
392 DO K=KTS,KTE
393 DO I=MYIS1_P2,MYIE1_P2
394 FNE_X=FNE(I,K,JJ)
395 TNE(I,K,-1)=FNE_X*(TST(I+IHE(JJ),K,0)-TST(I,K,-1))
396 !
397 FSE_X=FSE(I,K,JJ+1)
398 TSE(I,K,0)=FSE_X*(TST(I+IHE(JJ+1),K,-1)-TST(I,K,0))
399 !
400 UNE(I,K,-1)=(FNE(I+IVW(JJ),K,JJ)+FNE(I+IVE(JJ),K,JJ)) &
401 & *(UST(I+IVE(JJ),K,0)-UST(I,K,-1))
402 USE(I,K,0)=(FSE(I+IVW(JJ+1),K,JJ+1)+FSE(I+IVE(JJ+1),K,JJ+1)) &
403 & *(UST(I+IVE(JJ+1),K,-1)-UST(I,K,0))
404 VNE(I,K,-1)=(FNE(I,K,JJ-1)+FNE(I,K,JJ+1)) &
405 & *(VST(I+IVE(JJ),K,0)-VST(I,K,-1))
406 VSE(I,K,0)=(FSE(I,K,JJ)+FSE(I,K,JJ+2)) &
407 & *(VST(I+IVE(JJ+1),K,-1)-VST(I,K,0))
408 ENDDO
409 ENDDO
410 !
411 JKNT=0
412 !
413 !-----------------------------------------------------------------------
414 !-----------------------------------------------------------------------
415 !
416 main_integration : DO J=JSTART,JEND
417 !
418 !-----------------------------------------------------------------------
419 !-----------------------------------------------------------------------
420 !***
421 !*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
422 !*** AND PFDHT DIAGRAMS)
423 !***
424 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
425 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
426 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
427 !*** THE CURRENT VALUE OF THE main_integration LOOP.
428 !*** (P3 denotes +3, M1 denotes -1, etc.)
429 !***
430
431 !
432 ! John and Tom both think this is all right, even for tiles,
433 ! as long as the slab arrays being indexed by these things
434 ! are locally defined.
435 !
436 JKNT=JKNT+1
437 !
438 J0_P3=INDX3_WRK(3,JKNT,0)
439 J0_P2=INDX3_WRK(2,JKNT,0)
440 J0_P1=INDX3_WRK(1,JKNT,0)
441 J0_00=INDX3_WRK(0,JKNT,0)
442 J0_M1=INDX3_WRK(-1,JKNT,0)
443 !
444 J1_P2=INDX3_WRK(2,JKNT,1)
445 J1_P1=INDX3_WRK(1,JKNT,1)
446 J1_00=INDX3_WRK(0,JKNT,1)
447 J1_M1=INDX3_WRK(-1,JKNT,1)
448 !
449 J2_P1=INDX3_WRK(1,JKNT,2)
450 J2_00=INDX3_WRK(0,JKNT,2)
451 J2_M1=INDX3_WRK(-1,JKNT,2)
452 !
453 J3_P2=INDX3_WRK(2,JKNT,3)
454 J3_P1=INDX3_WRK(1,JKNT,3)
455 J3_00=INDX3_WRK(0,JKNT,3)
456 !
457 J4_P1=INDX3_WRK(1,JKNT,4)
458 J4_00=INDX3_WRK(0,JKNT,4)
459 J4_M1=INDX3_WRK(-1,JKNT,4)
460 !
461 J5_00=INDX3_WRK(0,JKNT,5)
462 J5_M1=INDX3_WRK(-1,JKNT,5)
463 !
464 J6_P1=INDX3_WRK(1,JKNT,6)
465 J6_00=INDX3_WRK(0,JKNT,6)
466 !
467 MY_IS_GLB=1 ! make this a noop for global indexing
468 MY_IE_GLB=1 ! make this a noop for global indexing
469 MY_JS_GLB=1 ! make this a noop for global indexing
470 MY_JE_GLB=1 ! make this a noop for global indexing
471 !
472 !-----------------------------------------------------------------------
473 !*** THE WORKING ARRAYS FOR THE PRIMARY VARIABLES
474 !-----------------------------------------------------------------------
475 !
476 DO K=KTS,KTE
477 DO I=MYIS_P4,MYIE_P4
478 TST(I,K,J1_P2)=T(I,K,J+2)*FFC+TOLD(I,K,J+2)*FBC
479 UST(I,K,J1_P2)=U(I,K,J+2)*FFC+UOLD(I,K,J+2)*FBC
480 VST(I,K,J1_P2)=V(I,K,J+2)*FFC+VOLD(I,K,J+2)*FBC
481 ENDDO
482 ENDDO
483 !
484 !-----------------------------------------------------------------------
485 !*** MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
486 !-----------------------------------------------------------------------
487 !
488 DO K=KTS,KTE
489 DO I=MYIS_P4,MYIE_P4
490 !
491 !-----------------------------------------------------------------------
492 !*** THE NS AND EW FLUXES IN THE FOLLOWING LOOP ARE ON V POINTS
493 !*** FOR T.
494 !-----------------------------------------------------------------------
495 !
496 DPDE_P3=DETA1_PDTOP(K)+DETA2(K)*PDSLO(I,J+3)
497 DPDE(I,K,J0_P3)=DPDE_P3
498 !
499 !-----------------------------------------------------------------------
500 UDY(I,K,J1_P2)=U(I,K,J+2)*DY
501 VDX_P2=V(I,K,J+2)*DX(I,J+2)
502 VDX(I,K,J1_P2)=VDX_P2
503 FNS(I,K,J+2)=VDX_P2*(DPDE(I,K,J0_P1)+DPDE_P3)
504 ENDDO
505 ENDDO
506 !
507 !-----------------------------------------------------------------------
508 DO K=KTS,KTE
509 DO I=MYIS_P3,MYIE_P3
510 TEMPA=(UDY(I+IHE(J+1),K,J1_P1)+VDX(I+IHE(J+1),K,J1_P1)) &
511 & +(UDY(I,K,J1_P2) +VDX(I,K,J1_P2))
512 FNE(I,K,J+1)=TEMPA*(DPDE(I,K,J0_P1)+DPDE(I+IHE(J+1),K,J0_P2))
513 !
514 !-----------------------------------------------------------------------
515 TEMPB=(UDY(I+IHE(J+2),K,J1_P2)-VDX(I+IHE(J+2),K,J1_P2)) &
516 & +(UDY(I,K,J1_P1) -VDX(I,K,J1_P1))
517 FSE(I,K,J+2)=TEMPB*(DPDE(I,K,J0_P2)+DPDE(I+IHE(J),K,J0_P1))
518 !
519 !-----------------------------------------------------------------------
520 FNS_P1=FNS(I,K,J+1)
521 TNS(I,K,J4_P1)=FNS_P1*(TST(I,K,J1_P2)-TST(I,K,J1_00))
522 !
523 !-----------------------------------------------------------------------
524 UDY_P1=U(I,K,J+1)*DY
525 FEW(I,K,J+1)=UDY_P1*(DPDE(I+IVW(J+1),K,J0_P1) &
526 & +DPDE(I+IVE(J+1),K,J0_P1))
527 FEW_00=FEW(I,K,J)
528 TEW(I,K)=FEW_00*(TST(I+IVE(J),K,J1_00)-TST(I+IVW(J),K,J1_00))
529 !
530 !-----------------------------------------------------------------------
531 !*** THE NE AND SE FLUXES ARE ASSOCIATED WITH H POINTS
532 !*** (ACTUALLY JUST TO THE NE AND SE OF EACH H POINT).
533 !-----------------------------------------------------------------------
534 !
535 FNE_X=FNE(I,K,J)
536 TNE(I,K,J5_00)=FNE_X*(TST(I+IHE(J),K,J1_P1)-TST(I,K,J1_00))
537 !
538 FSE_X=FSE(I,K,J+1)
539 TSE(I,K,J6_P1)=FSE_X*(TST(I+IHE(J+1),K,J1_00)-TST(I,K,J1_P1))
540 ENDDO
541 ENDDO
542 !
543 !-----------------------------------------------------------------------
544 !*** CALCULATION OF MOMENTUM ADVECTION COMPONENTS
545 !-----------------------------------------------------------------------
546 !-----------------------------------------------------------------------
547 !*** THE NS AND EW FLUXES ARE ON H POINTS FOR U AND V.
548 !-----------------------------------------------------------------------
549 !
550 DO K=KTS,KTE
551 DO I=MYIS_P2,MYIE_P2
552 UEW(I,K)=(FEW(I+IHW(J),K,J)+FEW(I+IHE(J),K,J)) &
553 & *(UST(I+IHE(J),K,J1_00)-UST(I+IHW(J),K,J1_00))
554 UNS(I,K,J4_P1)=(FNS(I+IHW(J+1),K,J+1) &
555 & +FNS(I+IHE(J+1),K,J+1)) &
556 & *(UST(I,K,J1_P2)-UST(I,K,J1_00))
557 VEW(I,K)=(FEW(I,K,J-1)+FEW(I,K,J+1)) &
558 & *(VST(I+IHE(J),K,J1_00)-VST(I+IHW(J),K,J1_00))
559 VNS(I,K,J4_P1)=(FNS(I,K,J)+FNS(I,K,J+2)) &
560 & *(VST(I,K,J1_P2)-VST(I,K,J1_00))
561 !
562 !-----------------------------------------------------------------------
563 !*** THE FOLLOWING NE AND SE FLUXES ARE TIED TO V POINTS AND ARE
564 !*** LOCATED JUST TO THE NE AND SE OF THE GIVEN I,J.
565 !-----------------------------------------------------------------------
566 !
567 UNE(I,K,J5_00)=(FNE(I+IVW(J),K,J)+FNE(I+IVE(J),K,J)) &
568 & *(UST(I+IVE(J),K,J1_P1)-UST(I,K,J1_00))
569 USE(I,K,J6_P1)=(FSE(I+IVW(J+1),K,J+1) &
570 & +FSE(I+IVE(J+1),K,J+1)) &
571 & *(UST(I+IVE(J+1),K,J1_00)-UST(I,K,J1_P1))
572 VNE(I,K,J5_00)=(FNE(I,K,J-1)+FNE(I,K,J+1)) &
573 & *(VST(I+IVE(J),K,J1_P1)-VST(I,K,J1_00))
574 VSE(I,K,J6_P1)=(FSE(I,K,J)+FSE(I,K,J+2)) &
575 & *(VST(I+IVE(J+1),K,J1_00)-VST(I,K,J1_P1))
576 ENDDO
577 ENDDO
578 !
579 !-----------------------------------------------------------------------
580 !*** COMPUTE THE ADVECTION TENDENCIES FOR T.
581 !*** THE AD ARRAYS ARE ON H POINTS.
582 !*** SKIP TO UPSTREAM IF THESE ROWS HAVE ONLY UPSTREAM POINTS.
583 !-----------------------------------------------------------------------
584 !
585
586 JGLOBAL=J+MY_JS_GLB-1
587 IF(JGLOBAL>=6.AND.JGLOBAL<=JDE-5)THEN
588 !
589 JJ=J+MY_JS_GLB-1 ! okay because MY_JS_GLB is 1
590 IF(ITS==IDS)ISTART=3+MOD(JJ,2) ! need to think about this
591 ! more in terms of how to
592 ! convert to global indexing
593 !
594 DO K=KTS,KTE
595 DO I=ISTART,IEND
596 RDPD=1./DPDE(I,K,J0_00)
597 !
598 ADT(I,K,J)=(TEW(I+IHW(J),K)+TEW(I+IHE(J),K) &
599 & +TNS(I,K,J4_M1)+TNS(I,K,J4_P1) &
600 & +TNE(I+IHW(J),K,J5_M1)+TNE(I,K,J5_00) &
601 & +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1)) &
602 & *RDPD*FAD(I,J)
603 !
604 ENDDO
605 ENDDO
606 !
607 !-----------------------------------------------------------------------
608 !*** COMPUTE THE ADVECTION TENDENCIES FOR U AND V.
609 !*** THE AD ARRAYS ARE ON VELOCITY POINTS.
610 !-----------------------------------------------------------------------
611 !
612 IF(ITS==IDS)ISTART=3+MOD(JJ+1,2)
613 !
614 DO K=KTS,KTE
615 DO I=ISTART,IEND
616 RDPDX=1./(DPDE(I+IVW(J),K,J0_00)+DPDE(I+IVE(J),K,J0_00))
617 RDPDY=1./(DPDE(I,K,J0_M1)+DPDE(I,K,J0_P1))
618 !
619 ADU(I,K,J)=(UEW(I+IVW(J),K)+UEW(I+IVE(J),K) &
620 & +UNS(I,K,J4_M1)+UNS(I,K,J4_P1) &
621 & +UNE(I+IVW(J),K,J5_M1)+UNE(I,K,J5_00) &
622 & +USE(I,K,J6_00)+USE(I+IVW(J),K,J6_P1)) &
623 & *RDPDX*FAD(I+IVW(J),J)
624 !
625 ADV(I,K,J)=(VEW(I+IVW(J),K)+VEW(I+IVE(J),K) &
626 & +VNS(I,K,J4_M1)+VNS(I,K,J4_P1) &
627 & +VNE(I+IVW(J),K,J5_M1)+VNE(I,K,J5_00) &
628 & +VSE(I,K,J6_00)+VSE(I+IVW(J),K,J6_P1)) &
629 & *RDPDY*FAD(I+IVW(J),J)
630 !
631 ENDDO
632 ENDDO
633 !
634 ENDIF
635 !
636 !-----------------------------------------------------------------------
637 !-----------------------------------------------------------------------
638 !
639 !*** END OF JANJIC HORIZONTAL ADVECTION
640 !
641 !-----------------------------------------------------------------------
642 !-----------------------------------------------------------------------
643 !*** UPSTREAM ADVECTION OF T, U, AND V
644 !-----------------------------------------------------------------------
645 !-----------------------------------------------------------------------
646 !
647 upstream : IF(UPSTRM)THEN
648 !
649 !-----------------------------------------------------------------------
650 !***
651 !*** COMPUTE UPSTREAM COMPUTATIONS ON THIS TASK'S ROWS.
652 !***
653 !-----------------------------------------------------------------------
654 !
655 N_IUPH_J=N_IUP_H(J) ! See explanation in INIT
656 !
657 DO K=KTS,KTE
658 !
659 DO II=0,N_IUPH_J-1
660 I=IUP_H(IMS+II,J)
661 TTA=EMT_LOC(J)*(UST(I,K,J1_M1)+UST(I+IHW(J),K,J1_00) &
662 & +UST(I+IHE(J),K,J1_00)+UST(I,K,J1_P1))
663 TTB=ENT *(VST(I,K,J1_M1)+VST(I+IHW(J),K,J1_00) &
664 & +VST(I+IHE(J),K,J1_00)+VST(I,K,J1_P1))
665 PP=-TTA-TTB
666 QP= TTA-TTB
667 !
668 IF(PP<0.)THEN
669 ISPA(I,K)=-1
670 ELSE
671 ISPA(I,K)= 1
672 ENDIF
673 !
674 IF(QP<0.)THEN
675 ISQA(I,K)=-1
676 ELSE
677 ISQA(I,K)= 1
678 ENDIF
679 !
680 PP=ABS(PP)
681 QP=ABS(QP)
682 ARRAY3_X=PP*QP
683 ARRAY0(I,K)=ARRAY3_X-PP-QP
684 ARRAY1(I,K)=PP-ARRAY3_X
685 ARRAY2(I,K)=QP-ARRAY3_X
686 ARRAY3(I,K)=ARRAY3_X
687 ENDDO
688 !
689 ENDDO
690 !-----------------------------------------------------------------------
691 !
692 N_IUPADH_J=N_IUP_ADH(J)
693 !
694 DO K=KTS,KTE
695 !
696 KNTI_ADH=1
697 IUP_ADH_J=IUP_ADH(IMS,J)
698 !
699 DO II=0,N_IUPH_J-1
700 I=IUP_H(IMS+II,J)
701 !
702 ISP=ISPA(I,K)
703 ISQ=ISQA(I,K)
704 IFP=(ISP-1)/2
705 IFQ=(-ISQ-1)/2
706 IPQ=(ISP-ISQ)/2
707 !
708 IF(HTM(I+IHE(J)+IFP,K,J+ISP) &
709 & *HTM(I+IHE(J)+IFQ,K,J+ISQ) &
710 & *HTM(I+IPQ,K,J+ISP+ISQ)>0.1)THEN
711 GO TO 150
712 ENDIF
713 !
714 IF(HTM(I+IHE(J)+IFP,K,J+ISP) &
715 & +HTM(I+IHE(J)+IFQ,K,J+ISQ) &
716 & +HTM(I+IPQ,K,J+ISP+ISQ)<0.1)THEN
717 !
718 T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
719 T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
720 T(I+IPQ,K,J+ISP+ISQ)=T(I,K,J)
721 !
722 ELSEIF &
723 & (HTM(I+IHE(J)+IFP,K,J+ISP)+HTM(I+IPQ,K,J+ISP+ISQ) &
724 & <0.99)THEN
725 !
726 T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J)
727 T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFQ,K,J+ISQ)
728 !
729 ELSEIF &
730 & (HTM(I+IHE(J)+IFQ,K,J+ISQ)+HTM(I+IPQ,K,J+ISP+ISQ) &
731 <0.99)THEN
732 !
733 T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J)
734 T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
735 !
736 ELSEIF &
737 & (HTM(I+IHE(J)+IFP,K,J+ISP) &
738 & +HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
739 T(I+IHE(J)+IFP,K,J+ISP)=0.5*(T(I,K,J) &
740 & +T(I+IPQ,K,J+ISP+ISQ))
741 T(I+IHE(J)+IFQ,K,J+ISQ)=T(I+IHE(J)+IFP,K,J+ISP)
742 !
743 ELSEIF(HTM(I+IHE(J)+IFP,K,J+ISP)<0.99)THEN
744 T(I+IHE(J)+IFP,K,J+ISP)=T(I,K,J) &
745 & +T(I+IPQ,K,J+ISP+ISQ) &
746 & -T(I+IHE(J)+IFQ,K,J+ISQ)
747 !
748 ELSEIF(HTM(I+IHE(J)+IFQ,K,J+ISQ)<0.99)THEN
749 T(I+IHE(J)+IFQ,K,J+ISQ)=T(I,K,J) &
750 & +T(I+IPQ,K,J+ISP+ISQ) &
751 & -T(I+IHE(J)+IFP,K,J+ISP)
752 !
753 ELSE
754 T(I+IPQ,K,J+ISP+ISQ)=T(I+IHE(J)+IFP,K,J+ISP) &
755 & +T(I+IHE(J)+IFQ,K,J+ISQ) &
756 & -T(I,K,J)
757 !
758 ENDIF
759 !
760 150 CONTINUE
761 !
762 !-----------------------------------------------------------------------
763 !
764 IF(I==IUP_ADH_J)THEN ! Update advection H tendencies
765 !
766 ISP=ISPA(I,K)
767 ISQ=ISQA(I,K)
768 IFP=(ISP-1)/2
769 IFQ=(-ISQ-1)/2
770 IPQ=(ISP-ISQ)/2
771 !
772 F0=ARRAY0(I,K)
773 F1=ARRAY1(I,K)
774 F2=ARRAY2(I,K)
775 F3=ARRAY3(I,K)
776 !
777 ADT(I,K,J)=F0*T(I,K,J) &
778 & +F1*T(I+IHE(J)+IFP,K,J+ISP) &
779 & +F2*T(I+IHE(J)+IFQ,K,J+ISQ) &
780 +F3*T(I+IPQ,K,J+ISP+ISQ)
781 !
782 !-----------------------------------------------------------------------
783 !
784 IF(KNTI_ADH<N_IUPADH_J)THEN
785 IUP_ADH_J=IUP_ADH(IMS+KNTI_ADH,J)
786 KNTI_ADH=KNTI_ADH+1
787 ENDIF
788 !
789 ENDIF ! End of advection H tendency IF block
790 !
791 ENDDO ! End of II loop
792 !
793 ENDDO ! End of K loop
794 !
795 !-----------------------------------------------------------------------
796 !-----------------------------------------------------------------------
797 !*** UPSTREAM ADVECTION OF VELOCITY COMPONENTS
798 !-----------------------------------------------------------------------
799 !-----------------------------------------------------------------------
800 !
801 N_IUPADV_J=N_IUP_ADV(J)
802 !
803 DO K=KTS,KTE
804 !
805 DO II=0,N_IUPADV_J-1
806 I=IUP_ADV(IMS+II,J)
807 !
808 TTA=EM_LOC(J)*UST(I,K,J1_00)
809 TTB=EN *VST(I,K,J1_00)
810 PP=-TTA-TTB
811 QP=TTA-TTB
812 !
813 IF(PP<0.)THEN
814 ISP=-1
815 ELSE
816 ISP= 1
817 ENDIF
818 !
819 IF(QP<0.)THEN
820 ISQ=-1
821 ELSE
822 ISQ= 1
823 ENDIF
824 !
825 IFP=(ISP-1)/2
826 IFQ=(-ISQ-1)/2
827 IPQ=(ISP-ISQ)/2
828 PP=ABS(PP)
829 QP=ABS(QP)
830 F3=PP*QP
831 F0=F3-PP-QP
832 F1=PP-F3
833 F2=QP-F3
834 !
835 ADU(I,K,J)=F0*U(I,K,J) &
836 & +F1*U(I+IVE(J)+IFP,K,J+ISP) &
837 & +F2*U(I+IVE(J)+IFQ,K,J+ISQ) &
838 & +F3*U(I+IPQ,K,J+ISP+ISQ)
839 !
840 ADV(I,K,J)=F0*V(I,K,J) &
841 & +F1*V(I+IVE(J)+IFP,K,J+ISP) &
842 & +F2*V(I+IVE(J)+IFQ,K,J+ISQ) &
843 & +F3*V(I+IPQ,K,J+ISP+ISQ)
844 !
845 ENDDO
846 !
847 ENDDO ! End of K loop
848 !
849 !-----------------------------------------------------------------------
850 !
851 ENDIF upstream
852 !
853 !-----------------------------------------------------------------------
854 !-----------------------------------------------------------------------
855 !*** END OF THIS UPSTREAM REGION
856 !-----------------------------------------------------------------------
857 !-----------------------------------------------------------------------
858 !
859 !*** COMPUTE VERTICAL ADVECTION TENDENCIES USING CRANK-NICHOLSON.
860 !
861 !-----------------------------------------------------------------------
862 !*** FIRST THE TEMPERATURE
863 !-----------------------------------------------------------------------
864 !
865 iloop_for_t: DO I=MYIS1,MYIE1
866 !
867 PDOP=PDSLO(I,J)
868 PVVLO=PETDT(I,KTE-1,J)*DTQ
869 VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
870 CMT=-VVLO+1.
871 RCMT(KTE)=1./CMT
872 CRT(KTE)=VVLO
873 RSTT(KTE)=-VVLO*(T(I,KTE-1,J)-T(I,KTE,J))+T(I,KTE,J)
874 !
875 LMHK=KTE-LMH(I,J)+1
876 DO K=KTE-1,LMHK+1,-1
877 RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
878 PVVUP=PVVLO
879 PVVLO=PETDT(I,K-1,J)*DTQ
880 VVUP=PVVUP*RDP
881 VVLO=PVVLO*RDP
882 CFT=-VVUP*RCMT(K+1)
883 CMT=-CRT(K+1)*CFT+(VVUP-VVLO+1.)
884 RCMT(K)=1./CMT
885 CRT(K)=VVLO
886 RSTT(K)=-RSTT(K+1)*CFT+T(I,K,J) &
887 & -(T(I,K,J)-T(I,K+1,J))*VVUP &
888 & -(T(I,K-1,J)-T(I,K,J))*VVLO
889 ENDDO
890 !
891 PVVUP=PVVLO
892 VVUP=PVVUP/(DETA1_PDTOP(LMHK)+DETA2(LMHK)*PDOP)
893 CFT=-VVUP*RCMT(LMHK+1)
894 CMT=-CRT(LMHK+1)*CFT+VVUP+1.
895 CRT(LMHK)=0.
896 RSTT(LMHK)=-(T(I,LMHK,J)-T(I,LMHK+1,J))*VVUP &
897 & -RSTT(LMHK+1)*CFT+T(I,LMHK,J)
898 TN(LMHK)=RSTT(LMHK)/CMT
899 VAD_TEND_T(I,LMHK)=TN(LMHK)-T(I,LMHK,J)
900 !
901 DO K=LMHK+1,KTE
902 TN(K)=(-CRT(K)*TN(K-1)+RSTT(K))*RCMT(K)
903 VAD_TEND_T(I,K)=TN(K)-T(I,K,J)
904 ENDDO
905 !
906 !-----------------------------------------------------------------------
907 !*** The following section is only for checking the implicit solution
908 !*** using back-substitution. Remove this section otherwise.
909 !-----------------------------------------------------------------------
910 !
911 ! IF(I==ITEST.AND.J==JTEST)THEN
912 !!
913 ! PVVLO=PETDT(I,KTE-1,J)*DT*0.25
914 ! VVLO=PVVLO/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOP)
915 ! TTLO=VVLO*(T(I,KTE-1,J)-T(I,KTE,J) &
916 ! & +TN(KTE-1)-TN(KTE))
917 ! ADTP=TTLO+TN(KTE)-T(I,KTE,J)
918 ! WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTE &
919 ! &, ' ADTP=',ADTP
920 ! WRITE(0,*)' T=',T(I,KTE,J),' TN=',TN(KTE) &
921 ! &, ' VAD_TEND_T=',VAD_TEND_T(I,KTE)
922 ! WRITE(0,*)' '
923 !!
924 ! DO K=KTE-1,LMHK+1,-1
925 ! RDP=1./(DETA1_PDTOP(K)+DETA2(K)*PDOP)
926 ! PVVUP=PVVLO
927 ! PVVLO=PETDT(I,K-1,J)*DT*0.25
928 ! VVUP=PVVUP*RDP
929 ! VVLO=PVVLO*RDP
930 ! TTUP=VVUP*(T(I,K,J)-T(I,K+1,J)+TN(K)-TN(K+1))
931 ! TTLO=VVLO*(T(I,K-1,J)-T(I,K,J)+TN(K-1)-TN(K))
932 ! ADTP=TTLO+TTUP+TN(K)-T(I,K,J)
933 ! WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',K &
934 ! &, ' ADTP=',ADTP
935 ! WRITE(0,*)' T=',T(I,K,J),' TN=',TN(K) &
936 ! &, ' VAD_TEND_T=',VAD_TEND_T(I,K)
937 ! WRITE(0,*)' '
938 ! ENDDO
939 !!
940 ! IF(LMHK==KTS)THEN
941 ! PVVUP=PVVLO
942 ! VVUP=PVVUP/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOP)
943 ! TTUP=VVUP*(T(I,KTS,J)-T(I,KTS+1,J)+TN(KTS)-TN(KTS+1))
944 ! ADTP=TTUP+TN(KTS)-T(I,KTS,J)
945 ! WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTS &
946 ! &, ' ADTP=',ADTP
947 ! WRITE(0,*)' T=',T(I,KTS,J),' TN=',TN(KTS) &
948 ! &, ' VAD_TEND_T=',VAD_TEND_T(I,KTS)
949 ! WRITE(0,*)' '
950 ! ENDIF
951 ! ENDIF
952 !
953 !-----------------------------------------------------------------------
954 !*** End of check.
955 !-----------------------------------------------------------------------
956 !
957 ENDDO iloop_for_t
958 !
959 !-----------------------------------------------------------------------
960 !*** NOW VERTICAL ADVECTION OF WIND COMPONENTS
961 !-----------------------------------------------------------------------
962 !
963 iloop_for_uv: DO I=MYIS1,MYIE1
964 !
965 PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
966 PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
967 PVVLOU=(PETDT(I+IVW(J),KTE-1,J)+PETDT(I+IVE(J),KTE-1,J))*DTE
968 PVVLOV=(PETDT(I,KTE-1,J-1)+PETDT(I,KTE-1,J+1))*DTE
969 VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
970 VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
971 CMU=-VVLOU+1.
972 CMV=-VVLOV+1.
973 RCMU(KTE)=1./CMU
974 RCMV(KTE)=1./CMV
975 CRU(KTE)=VVLOU
976 CRV(KTE)=VVLOV
977 RSTU(KTE)=-VVLOU*(U(I,KTE-1,J)-U(I,KTE,J))+U(I,KTE,J)
978 RSTV(KTE)=-VVLOV*(V(I,KTE-1,J)-V(I,KTE,J))+V(I,KTE,J)
979 !
980 LMVK=KTE-LMV(I,J)+1
981 DO K=KTE-1,LMVK+1,-1
982 RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
983 RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
984 PVVUPU=PVVLOU
985 PVVUPV=PVVLOV
986 PVVLOU=(PETDT(I+IVW(J),K-1,J)+PETDT(I+IVE(J),K-1,J))*DTE
987 PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
988 VVUPU=PVVUPU*RDPU
989 VVUPV=PVVUPV*RDPV
990 VVLOU=PVVLOU*RDPU
991 VVLOV=PVVLOV*RDPV
992 CFU=-VVUPU*RCMU(K+1)
993 CFV=-VVUPV*RCMV(K+1)
994 CMU=-CRU(K+1)*CFU+VVUPU-VVLOU+1.
995 CMV=-CRV(K+1)*CFV+VVUPV-VVLOV+1.
996 RCMU(K)=1./CMU
997 RCMV(K)=1./CMV
998 CRU(K)=VVLOU
999 CRV(K)=VVLOV
1000 RSTU(K)=-RSTU(K+1)*CFU+U(I,K,J) &
1001 & -(U(I,K,J)-U(I,K+1,J))*VVUPU &
1002 & -(U(I,K-1,J)-U(I,K,J))*VVLOU
1003 RSTV(K)=-RSTV(K+1)*CFV+V(I,K,J) &
1004 & -(V(I,K,J)-V(I,K+1,J))*VVUPV &
1005 & -(V(I,K-1,J)-V(I,K,J))*VVLOV
1006 ENDDO
1007 !
1008 RDPU=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPU)
1009 RDPV=1./(DETA1_PDTOP(LMVK)+DETA2(LMVK)*PDOPV)
1010 PVVUPU=PVVLOU
1011 PVVUPV=PVVLOV
1012 VVUPU=PVVUPU*RDPU
1013 VVUPV=PVVUPV*RDPV
1014 CFU=-VVUPU*RCMU(LMVK+1)
1015 CFV=-VVUPV*RCMV(LMVK+1)
1016 CMU=-CRU(LMVK+1)*CFU+VVUPU+1.
1017 CMV=-CRV(LMVK+1)*CFV+VVUPV+1.
1018 CRU(LMVK)=0.
1019 CRV(LMVK)=0.
1020 RSTU(LMVK)=-(U(I,LMVK,J)-U(I,LMVK+1,J))*VVUPU &
1021 & -RSTU(LMVK+1)*CFU+U(I,LMVK,J)
1022 RSTV(LMVK)=-(V(I,LMVK,J)-V(I,LMVK+1,J))*VVUPV &
1023 & -RSTV(LMVK+1)*CFV+V(I,LMVK,J)
1024 UN(LMVK)=RSTU(LMVK)/CMU
1025 VN(LMVK)=RSTV(LMVK)/CMV
1026 VAD_TEND_U(I,LMVK)=UN(LMVK)-U(I,LMVK,J)
1027 VAD_TEND_V(I,LMVK)=VN(LMVK)-V(I,LMVK,J)
1028 !
1029 DO K=LMVK+1,KTE
1030 UN(K)=(-CRU(K)*UN(K-1)+RSTU(K))*RCMU(K)
1031 VN(K)=(-CRV(K)*VN(K-1)+RSTV(K))*RCMV(K)
1032 VAD_TEND_U(I,K)=UN(K)-U(I,K,J)
1033 VAD_TEND_V(I,K)=VN(K)-V(I,K,J)
1034 ENDDO
1035 !
1036 !-----------------------------------------------------------------------
1037 !*** The following section is only for checking the implicit solution
1038 !*** using back-substitution. Remove this section otherwise.
1039 !-----------------------------------------------------------------------
1040 !
1041 ! IF(I==ITEST.AND.J==JTEST)THEN
1042 !!
1043 ! PDOPU=(PDSLO(I+IVW(J),J)+PDSLO(I+IVE(J),J))*0.5
1044 ! PDOPV=(PDSLO(I,J-1)+PDSLO(I,J+1))*0.5
1045 ! PVVLOU=(PETDT(I+IVW(J),KTE-1,J) &
1046 ! & +PETDT(I+IVE(J),KTE-1,J))*DTE
1047 ! PVVLOV=(PETDT(I,KTE-1,J-1) &
1048 ! & +PETDT(I,KTE-1,J+1))*DTE
1049 ! VVLOU=PVVLOU/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPU)
1050 ! VVLOV=PVVLOV/(DETA1_PDTOP(KTE)+DETA2(KTE)*PDOPV)
1051 ! TULO=VVLOU*(U(I,KTE-1,J)-U(I,KTE,J)+UN(KTE-1)-UN(KTE))
1052 ! TVLO=VVLOV*(V(I,KTE-1,J)-V(I,KTE,J)+VN(KTE-1)-VN(KTE))
1053 ! ADUP=TULO+UN(KTE)-U(I,KTE,J)
1054 ! ADVP=TVLO+VN(KTE)-V(I,KTE,J)
1055 ! WRITE(0,*)' NTSD=',NTSD,' I=',I,' J=',J,' K=',KTE &
1056 ! &, ' ADUP=',ADUP,' ADVP=',ADVP
1057 ! WRITE(0,*)' U=',U(I,KTE,J),' UN=',UN(KTE) &
1058 ! &, ' VAD_TEND_U=',VAD_TEND_U(I,KTE) &
1059 ! &, ' V=',V(I,KTE,J),' VN=',VN(KTE) &
1060 ! &, ' VAD_TEND_V=',VAD_TEND_V(I,KTE)
1061 ! WRITE(0,*)' '
1062 !!
1063 ! DO K=KTE-1,LMVK+1,-1
1064 ! RDPU=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPU)
1065 ! RDPV=1./(DETA1_PDTOP(K)+DETA2(K)*PDOPV)
1066 ! PVVUPU=PVVLOU
1067 ! PVVUPV=PVVLOV
1068 ! PVVLOU=(PETDT(I+IVW(J),K-1,J) &
1069 ! & +PETDT(I+IVE(J),K-1,J))*DTE
1070 ! PVVLOV=(PETDT(I,K-1,J-1)+PETDT(I,K-1,J+1))*DTE
1071 ! VVUPU=PVVUPU*RDPU
1072 ! VVUPV=PVVUPV*RDPV
1073 ! VVLOU=PVVLOU*RDPU
1074 ! VVLOV=PVVLOV*RDPV
1075 ! TUUP=VVUPU*(U(I,K,J)-U(I,K+1,J)+UN(K)-UN(K+1))
1076 ! TVUP=VVUPV*(V(I,K,J)-V(I,K+1,J)+VN(K)-VN(K+1))
1077 ! TULO=VVLOU*(U(I,K-1,J)-U(I,K,J)+UN(K-1)-UN(K))
1078 ! TVLO=VVLOV*(V(I,K-1,J)-V(I,K,J)+VN(K-1)-VN(K))
1079 ! ADUP=TUUP+TULO+UN(K)-U(I,K,J)
1080 ! ADVP=TVUP+TVLO+VN(K)-V(I,K,J)
1081 ! WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',K &
1082 ! &, ' ADUP=',ADUP,' ADVP=',ADVP
1083 ! WRITE(0,*)' U=',U(I,K,J),' UN=',UN(K) &
1084 ! &, ' VAD_TEND_U=',VAD_TEND_U(I,K) &
1085 ! &, ' V=',V(I,K,J),' VN=',VN(K) &
1086 ! &, ' VAD_TEND_V=',VAD_TEND_V(I,K)
1087 ! WRITE(0,*)' '
1088 ! ENDDO
1089 !!
1090 ! IF(LMVK==KTS)THEN
1091 ! PVVUPU=PVVLOU
1092 ! PVVUPV=PVVLOV
1093 ! VVUPU=PVVUPU/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPU)
1094 ! VVUPV=PVVUPV/(DETA1_PDTOP(KTS)+DETA2(KTS)*PDOPV)
1095 ! TUUP=VVUPU*(U(I,KTS,J)-U(I,KTS+1,J)+UN(KTS)-UN(KTS+1))
1096 ! TVUP=VVUPV*(V(I,KTS,J)-V(I,KTS+1,J)+VN(KTS)-VN(KTS+1))
1097 ! ADUP=TUUP+UN(KTS)-U(I,KTS,J)
1098 ! ADVP=TVUP+VN(KTS)-V(I,KTS,J)
1099 ! WRITE(0,*)' NTSD=',NTSD,' I=',ITEST,' J=',JTEST,' K=',KTS &
1100 ! &, ' ADUP=',ADUP,' ADVP=',ADVP
1101 ! WRITE(0,*)' U=',U(I,KTS,J),' UN=',UN(KTS) &
1102 ! &, ' VAD_TEND_U=',VAD_TEND_U(I,KTS) &
1103 ! &, ' V=',V(I,KTS,J),' VN=',VN(KTS) &
1104 ! &, ' VAD_TEND_V=',VAD_TEND_V(I,KTS)
1105 ! WRITE(0,*)' '
1106 ! ENDIF
1107 ! ENDIF
1108 !
1109 !-----------------------------------------------------------------------
1110 !*** End of check.
1111 !-----------------------------------------------------------------------
1112 !
1113 ENDDO iloop_for_uv
1114 !
1115 !
1116 !-----------------------------------------------------------------------
1117 !
1118 !*** NOW SUM THE VERTICAL AND HORIZONTAL TENDENCIES,
1119 !*** CURVATURE AND CORIOLIS TERMS
1120 !
1121 !-----------------------------------------------------------------------
1122 !
1123 DO K=KTS,KTE
1124 DO I=MYIS1,MYIE1
1125 HM=HTM(I,K,J)*HBM2(I,J)
1126 VM=VTM(I,K,J)*VBM2(I,J)
1127 ADT(I,K,J)=(VAD_TEND_T(I,K)+2.*ADT(I,K,J))*HM
1128 !
1129 FPP=CURV(I,J)*2.*UST(I,K,J1_00)+F(I,J)*2.
1130 ADU(I,K,J)=(VAD_TEND_U(I,K)+2.*ADU(I,K,J)+VST(I,K,J1_00)*FPP) &
1131 & *VM
1132 ADV(I,K,J)=(VAD_TEND_V(I,K)+2.*ADV(I,K,J)-UST(I,K,J1_00)*FPP) &
1133 & *VM
1134 ENDDO
1135 ENDDO
1136 !-----------------------------------------------------------------------
1137 !-----------------------------------------------------------------------
1138 !
1139 ENDDO main_integration
1140 !
1141 !-----------------------------------------------------------------------
1142 !-----------------------------------------------------------------------
1143 !
1144 !-----------------------------------------------------------------------
1145 !*** SAVE THE OLD VALUES FOR TIMESTEPPING
1146 !-----------------------------------------------------------------------
1147 !
1148 DO J=MYJS_P4,MYJE_P4
1149 DO K=KTS,KTE
1150 DO I=MYIS_P4,MYIE_P4
1151 TOLD(I,K,J)=T(I,K,J)
1152 UOLD(I,K,J)=U(I,K,J)
1153 VOLD(I,K,J)=V(I,K,J)
1154 ENDDO
1155 ENDDO
1156 ENDDO
1157 !
1158 !-----------------------------------------------------------------------
1159 !*** FINALLY UPDATE THE PROGNOSTIC VARIABLES
1160 !-----------------------------------------------------------------------
1161 !
1162 DO J=MYJS2,MYJE2
1163 DO K=KTS,KTE
1164 DO I=MYIS1,MYIE1
1165 T(I,K,J)=ADT(I,K,J)+T(I,K,J)
1166 U(I,K,J)=ADU(I,K,J)+U(I,K,J)
1167 V(I,K,J)=ADV(I,K,J)+V(I,K,J)
1168 ENDDO
1169 ENDDO
1170 ENDDO
1171 !-----------------------------------------------------------------------
1172 END SUBROUTINE ADVE
1173 !-----------------------------------------------------------------------