module_BNDRY_COND.F
References to this file elsewhere.
1 !-----------------------------------------------------------------------
2 !
3 !NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
4 !
5 !-----------------------------------------------------------------------
6 !
7 #include "nmm_loop_basemacros.h"
8 #include "nmm_loop_macros.h"
9 !
10 !-----------------------------------------------------------------------
11 !
12 MODULE MODULE_BNDRY_COND
13 !
14 !-----------------------------------------------------------------------
15 USE MODULE_STATE_DESCRIPTION
16 USE MODULE_MODEL_CONSTANTS
17 !-----------------------------------------------------------------------
18 #ifdef DM_PARALLEL
19 INCLUDE "mpif.h"
20 #endif
21 !-----------------------------------------------------------------------
22 REAL :: D06666=0.06666666
23 !-----------------------------------------------------------------------
24 !
25 CONTAINS
26 !
27 !***********************************************************************
28 SUBROUTINE BOCOH(GRIDID,NTSD,DT0,NEST,NBC,NBOCO,LAST_TIME,TSPH &
29 & ,LB,ETA1,ETA2,PDTOP,PT,RES,HTM &
30 & ,PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B &
31 & ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT &
32 & ,PD,T,Q,Q2,CWM,PINT,MOIST,N_MOIST,SCALAR,N_SCALAR &
33 #ifdef WRF_CHEM
34 & ,CHEM,NUMG,CONFIG_FLAGS &
35 #endif
36 & ,IJDS,IJDE,SPEC_BDY_WIDTH,Z & ! min/max(id,jd)
37 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
38 & ,IDS,IDE,JDS,JDE,KDS,KDE &
39 & ,IMS,IME,JMS,JME,KMS,KME &
40 & ,ITS,ITE,JTS,JTE,KTS,KTE)
41 !***********************************************************************
42 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
43 ! . . .
44 ! SUBPROGRAM: BOCOH UPDATE MASS POINTS ON BOUNDARY
45 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
46 !
47 ! ABSTRACT:
48 ! TEMPERATURE, SPECIFIC HUMIDITY, AND SURFACE PRESSURE
49 ! ARE UPDATED ON THE DOMAIN BOUNDARY BY APPLYING THE
50 ! PRE-COMPUTED TENDENCIES AT EACH TIME STEP.
51 !
52 ! PROGRAM HISTORY LOG:
53 ! 87-??-?? MESINGER - ORIGINATOR
54 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D in HORIZONTAL
55 ! 96-12-13 BLACK - FINAL MODIFICATION FOR NESTED RUNS
56 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
57 ! 00-01-06 BLACK - MODIFIED FOR JANJIC NONHYDROSTATIC CODE
58 ! 00-09-14 BLACK - MODIFIED FOR DIRECT ACCESS READ
59 ! 01-03-12 BLACK - CONVERTED TO WRF STRUCTURE
60 ! 02-08-29 MICHALAKES - CHANGED II=I-MY_IS_GLB+1 TO II=I
61 ! ADDED CONDITIONAL COMPILATION AROUND MPI
62 ! CONVERT INDEXING FROM LOCAL TO GLOBAL
63 ! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING
64 ! 04-11-18 BLACK - THREADED
65 !
66 ! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
67 ! INPUT ARGUMENT LIST:
68 !
69 ! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
70 ! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
71 ! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
72 !
73 ! OUTPUT ARGUMENT LIST:
74 !
75 ! OUTPUT FILES:
76 ! NONE
77 !
78 ! SUBPROGRAMS CALLED:
79 !
80 ! UNIQUE: NONE
81 !
82 ! LIBRARY: NONE
83 !
84 ! ATTRIBUTES:
85 ! LANGUAGE: FORTRAN 90
86 ! MACHINE : IBM
87 !$$$
88 !***********************************************************************
89 !-----------------------------------------------------------------------
90 #ifdef WRF_CHEM
91 USE MODULE_INPUT_CHEM_DATA
92 #endif
93 !-----------------------------------------------------------------------
94 !
95 IMPLICIT NONE
96 !
97 !-----------------------------------------------------------------------
98 LOGICAL,INTENT(IN) :: NEST
99 !
100 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
101 & ,IMS,IME,JMS,JME,KMS,KME &
102 & ,ITS,ITE,JTS,JTE,KTS,KTE
103 INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH
104 INTEGER,INTENT(IN) :: N_MOIST, N_SCALAR
105 #ifdef WRF_CHEM
106 INTEGER,INTENT(IN) :: NUMG
107 #endif
108 !
109 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
110 !-----------------------------------------------------------------------
111 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
112 ! NMM_MAX_DIM is set in configure.wrf and must agree with the value of
113 ! dimspec q in the Registry/Registry
114 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
115 !-----------------------------------------------------------------------
116 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
117 !
118 INTEGER,INTENT(IN) :: GRIDID
119 INTEGER,INTENT(IN) :: LB,NBC,NTSD
120 LOGICAL,INTENT(IN) :: LAST_TIME
121 INTEGER,INTENT(INOUT) :: NBOCO
122 !
123 REAL,INTENT(IN) :: DT0,PDTOP,PT,TSPH
124 !
125 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
126 !
127 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM
128 !
129 REAL,DIMENSION(IJDS:IJDE,1,SPEC_BDY_WIDTH,4) &
130 & ,INTENT(INOUT) :: PD_B,PD_BT
131 !
132 REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) &
133 & ,INTENT(INOUT) :: CWM_B,Q_B,Q2_B &
134 & ,T_B,U_B,V_B
135 REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) &
136 & ,INTENT(INOUT) :: CWM_BT,Q_BT,Q2_BT &
137 & ,T_BT,U_BT,V_BT
138 !
139 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES
140 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD
141 !
142 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM &
143 & ,PINT,Q &
144 & ,Q2,T,Z
145 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_MOIST),INTENT(INOUT) :: MOIST
146 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_SCALAR),INTENT(INOUT) :: SCALAR
147 #ifdef WRF_CHEM
148 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_CHEM),INTENT(INOUT) :: CHEM
149 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
150 #endif
151
152
153 !-----------------------------------------------------------------------
154 !
155 !*** LOCAL VARIABLES
156 !
157 INTEGER :: BF,I,IB,IBDY,II,IIM,IM,IRTN,ISIZ1,ISIZ2 &
158 & ,J,JB,JJ,JJM,JM,K,N,NN,NREC,REC,NV
159 INTEGER :: MY_IS_GLB,MY_JS_GLB,MY_IE_GLB,MY_JE_GLB
160 INTEGER :: I_M,ILPAD1,IRPAD1,JBPAD1,JTPAD1
161 !
162 LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
163 !
164 REAL :: BCHR,RHTM,SHTM,DT
165 REAL :: CONVFAC,RRI,PLYR
166 INTEGER KK,NUMGAS
167 REAL :: CWK
168 !-----------------------------------------------------------------------
169 !***********************************************************************
170 !-----------------------------------------------------------------------
171 !
172 #ifdef WRF_CHEM
173 ! DETERMINE THE INDEX OF THE LAST GAS SPECIES
174 NUMGAS=P_HO2
175 NUMGAS=NUMG
176 ! NUMGAS = GET_LAST_GAS(CONFIG_FLAGS%CHEM_OPT)
177 #endif
178 IM=IDE-IDS+1
179 JM=JDE-JDS+1
180 IIM=IM
181 JJM=JM
182 !
183 ISIZ1=2*LB
184 ISIZ2=2*LB*(KME-KMS)
185 !
186 W_BDY=(ITS==IDS)
187 E_BDY=(ITE==IDE)
188 S_BDY=(JTS==JDS)
189 N_BDY=(JTE==JDE)
190 !
191 ILPAD1=1
192 IF(W_BDY)ILPAD1=0
193 IRPAD1=1
194 IF(E_BDY)IRPAD1=0
195 JBPAD1=1
196 IF(S_BDY)JBPAD1=0
197 JTPAD1=1
198 IF(N_BDY)JTPAD1=0
199 !
200 MY_IS_GLB=ITS
201 MY_IE_GLB=ITE
202 MY_JS_GLB=JTS
203 MY_JE_GLB=JTE
204 !
205 DT=DT0
206 !
207 !-----------------------------------------------------------------------
208 !*** SOUTH AND NORTH BOUNDARIES
209 !-----------------------------------------------------------------------
210 !
211 !*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH
212 !
213 DO IBDY=1,2
214 !
215 !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
216 !
217 IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN
218 !
219 IF(IBDY==1)THEN
220 BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start)
221 JB=1 ! Which cell in from boundary
222 JJ=1 ! Which cell in the domain
223 ELSE
224 BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end)
225 JB=1 ! Which cell in from boundary
226 JJ=JJM ! Which cell in the domain
227 ENDIF
228 !
229 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
230 PD_B(I,1,JB,BF)=PD_B(I,1,JB,BF)+PD_BT(I,1,JB,BF)*DT
231 PD(I,JJ)=PD_B(I,1,JB,BF)
232 ENDDO
233 !
234 !$omp parallel do &
235 !$omp& private(i,k)
236 DO K=KTS,KTE
237 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
238 T_B(I,K,JB,BF)=T_B(I,K,JB,BF)+T_BT(I,K,JB,BF)*DT
239 Q_B(I,K,JB,BF)=Q_B(I,K,JB,BF)+Q_BT(I,K,JB,BF)*DT
240 Q2_B(I,K,JB,BF)=Q2_B(I,K,JB,BF)+Q2_BT(I,K,JB,BF)*DT
241 CWM_B(I,K,JB,BF)=CWM_B(I,K,JB,BF)+CWM_BT(I,K,JB,BF)*DT
242 T(I,K,JJ)=T_B(I,K,JB,BF)
243 Q(I,K,JJ)=Q_B(I,K,JB,BF)
244 Q2(I,K,JJ)=Q2_B(I,K,JB,BF)
245 CWM(I,K,JJ)=CWM_B(I,K,JB,BF)
246 PINT(I,K,JJ)=ETA1(K)*PDTOP &
247 & +ETA2(K)*PD(I,JJ)*RES(I,JJ)+PT
248 ENDDO
249 ENDDO
250 DO I_M=1,N_MOIST
251 IF(I_M==P_QV)THEN
252 !$omp parallel do &
253 !$omp& private(i,k)
254 DO K=KTS,KTE
255 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
256 MOIST(I,K,JJ,I_M)=Q(I,K,JJ)/(1.-Q(I,K,JJ))
257 ENDDO
258 ENDDO
259 ELSE
260 !$omp parallel do &
261 !$omp& private(i,k)
262 DO K=KTS,KTE
263 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
264 MOIST(I,K,JJ,I_M)=0.
265 ENDDO
266 ENDDO
267 ENDIF
268 ENDDO
269 DO I_M=2,N_SCALAR
270 !$omp parallel do &
271 !$omp& private(i,k)
272 DO K=KTS,KTE
273 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
274 SCALAR(I,K,JJ,I_M)=0.
275 ENDDO
276 ENDDO
277 ENDDO
278 #ifdef WRF_CHEM
279 !$omp parallel do &
280 !$omp& private(i,k,nv)
281 DO NV=2,NUMG
282 DO K=KTS,KTE
283 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
284 CALL BDY_CHEM_VALUE (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV,NUMG)
285 ENDDO
286 ENDDO
287 ENDDO
288 !$omp parallel do &
289 !$omp& private(i,k,nv)
290 DO NV=NUMG+1,NUM_CHEM
291 DO K=KTS,KTE
292 KK=MIN(K+1,KTE)
293 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
294 PLYR=(PINT(I,K,JJ)+PINT(I,KK,JJ))*0.5
295 RRI=R_D*T(I,K,JJ)*(1.+.608*Q(I,K,JJ))/PLYR
296 CONVFAC=PLYR/RGASUNIV/T(I,K,JJ)
297 CALL BDY_CHEM_VALUE_SORGAM (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV, &
298 CONFIG_FLAGS,RRI,CONVFAC,G)
299 ENDDO
300 ENDDO
301 ENDDO
302 #endif
303 ENDIF
304 ENDDO
305 !
306 !-----------------------------------------------------------------------
307 !*** WEST AND EAST BOUNDARIES
308 !-----------------------------------------------------------------------
309 !
310 !*** USE IBDY=1 FOR WEST; 2 FOR EAST.
311 !
312 DO IBDY=1,2
313 !
314 !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
315 !
316 IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN
317 IF(IBDY==1)THEN
318 BF=P_XSB ! Which boundary (XSB=the boundary where X is at its start)
319 IB=1 ! Which cell in from boundary
320 II=1 ! Which cell in the domain
321 ELSE
322 BF=P_XEB ! Which boundary (XEB=the boundary where X is at its end)
323 IB=1 ! Which cell in from boundary
324 II=IIM ! Which cell in the domain
325 ENDIF
326 !
327 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
328 IF(MOD(J,2)==1)THEN
329 PD_B(J,1,IB,BF)=PD_B(J,1,IB,BF)+PD_BT(J,1,IB,BF)*DT
330 PD(II,J)=PD_B(J,1,IB,BF)
331 ENDIF
332 ENDDO
333 !
334 !$omp parallel do &
335 !$omp& private(j,k)
336 DO K=KTS,KTE
337 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
338 !
339 IF(MOD(J,2)==1)THEN
340 T_B(J,K,IB,BF)=T_B(J,K,IB,BF)+T_BT(J,K,IB,BF)*DT
341 Q_B(J,K,IB,BF)=Q_B(J,K,IB,BF)+Q_BT(J,K,IB,BF)*DT
342 Q2_B(J,K,IB,BF)=Q2_B(J,K,IB,BF)+Q2_BT(J,K,IB,BF)*DT
343 CWM_B(J,K,IB,BF)=CWM_B(J,K,IB,BF)+CWM_BT(J,K,IB,BF)*DT
344 T(II,K,J)=T_B(J,K,IB,BF)
345 Q(II,K,J)=Q_B(J,K,IB,BF)
346 Q2(II,K,J)=Q2_B(J,K,IB,BF)
347 CWM(II,K,J)=CWM_B(J,K,IB,BF)
348 PINT(II,K,J)=ETA1(K)*PDTOP &
349 & +ETA2(K)*PD(II,J)*RES(II,J)+PT
350 ENDIF
351 !
352 ENDDO
353 ENDDO
354 !
355 DO I_M=1,N_MOIST
356 IF(I_M==P_QV)THEN
357 !$omp parallel do &
358 !$omp& private(j,k)
359 DO K=KTS,KTE
360 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
361 IF(MOD(J,2)==1)THEN
362 MOIST(II,K,J,I_M)=Q(II,K,J)/(1.-Q(II,K,J))
363 ENDIF
364 ENDDO
365 ENDDO
366 !
367 ELSE
368 !$omp parallel do &
369 !$omp& private(j,k)
370 DO K=KTS,KTE
371 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
372 IF(MOD(J,2)==1)THEN
373 MOIST(II,K,J,I_M)=0.
374 ENDIF
375 ENDDO
376 ENDDO
377 !
378 ENDIF
379 ENDDO
380 !
381 DO I_M=2,N_SCALAR
382 !$omp parallel do &
383 !$omp& private(j,k)
384 DO K=KTS,KTE
385 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
386 IF(MOD(J,2)==1)THEN
387 SCALAR(II,K,J,I_M)=0.
388 ENDIF
389 ENDDO
390 ENDDO
391 ENDDO
392 !
393 #ifdef WRF_CHEM
394 !$omp parallel do &
395 !$omp& private(nv,j,k)
396 DO K=KTS,KTE
397 KK=MIN(K+1,KTE)
398 DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
399 IF(MOD(J,2)==1)THEN
400 DO NV=2,NUMG
401 CALL BDY_CHEM_VALUE (CHEM(II,K,J,NV), Z(II,K,J), NV,NUMG)
402 ENDDO
403 !$omp parallel do &
404 !$omp& private(nv)
405 DO NV=NUMG+1,NUM_CHEM
406 PLYR=(PINT(II,K,J)+PINT(II,KK,J))*0.5
407 RRI=R_D*T(II,K,J)*(1.+P608*Q(II,K,J))/PLYR
408 CONVFAC=PLYR/RGASUNIV/T(II,K,J)
409 CALL BDY_CHEM_VALUE_SORGAM (CHEM(II,K,J,NV), Z(II,K,J), NV, &
410 & CONFIG_FLAGS,RRI,CONVFAC,G)
411 ENDDO
412 ENDIF
413 ENDDO
414 ENDDO
415
416 #endif
417 ENDIF
418 ENDDO
419 !
420 !-----------------------------------------------------------------------
421 !*** SPACE INTERPOLATION OF PD THEN REMAINING MASS VARIABLES
422 !*** AT INNER BOUNDARY
423 !-----------------------------------------------------------------------
424 !
425 !*** ONE ROW NORTH OF SOUTHERN BOUNDARY
426 !
427 IF(S_BDY)THEN
428 DO I=MYIS,MYIE1
429 SHTM=HTM(I,KTE,1)+HTM(I+1,KTE,1)+HTM(I,KTE,3)+HTM(I+1,KTE,3)
430 PD(I,2)=(PD(I,1)*HTM(I,KTE,1)+PD(I+1,1)*HTM(I+1,KTE,1) &
431 & +PD(I,3)*HTM(I,KTE,3)+PD(I+1,3)*HTM(I+1,KTE,3))/SHTM
432 ENDDO
433 ENDIF
434 !
435 !*** ONE ROW SOUTH OF NORTHERN BOUNDARY
436 !
437 IF(N_BDY)THEN
438 DO I=MYIS,MYIE1
439 CWK=PD(I,JJM-1)
440 SHTM=HTM(I,KTE,JJM-2)+HTM(I+1,KTE,JJM-2)+HTM(I,KTE,JJM) &
441 & +HTM(I+1,KTE,JJM)
442 PD(I,JJM-1)=(PD(I,JJM-2)*HTM(I,KTE,JJM-2) &
443 & +PD(I+1,JJM-2)*HTM(I+1,KTE,JJM-2) &
444 & +PD(I,JJM)*HTM(I,KTE,JJM) &
445 & +PD(I+1,JJM)*HTM(I+1,KTE,JJM))/SHTM
446
447 ! test.
448
449 IF(I<=IDE-1.AND.ABS(CWK-PD(I,JJM-1))>=300.)THEN
450 WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE NORTHERN BOUNDARY AT',I,JJM-1,'GRID #',GRIDID
451 WRITE(0,*)' ',CWK/100.
452 WRITE(0,*)PD(I,JJM)/100.,' ',PD(I+1,JJM)/100.
453 WRITE(0,*)' ',PD(I,JJM-1)/100.
454 WRITE(0,*)PD(I,JJM-2)/100.,' ',PD(I+1,JJM-2)/100.
455 WRITE(0,*)
456 ENDIF
457
458 ENDDO
459 ENDIF
460 !
461 !*** ONE ROW EAST OF WESTERN BOUNDARY
462 !
463 IF(W_BDY)THEN
464 DO J=4,JM-3,2
465 !
466 IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
467 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
468 CWK=PD(1,J)
469 JJ=J
470 SHTM=HTM(1,KTE,JJ-1)+HTM(2,KTE,JJ-1)+HTM(1,KTE,JJ+1) &
471 & +HTM(2,KTE,JJ+1)
472 PD(1,JJ)=(PD(1,JJ-1)*HTM(1,KTE,JJ-1) &
473 & +PD(2,JJ-1)*HTM(2,KTE,JJ-1) &
474 & +PD(1,JJ+1)*HTM(1,KTE,JJ+1) &
475 & +PD(2,JJ+1)*HTM(2,KTE,JJ+1))/SHTM
476
477 ! test.
478
479 IF(ABS(CWK-PD(1,JJ))>300.)THEN
480 WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE WESTERN BOUNDARY AT',J,1,'GRID #',GRIDID
481 WRITE(0,*)' ',CWK/100.
482 WRITE(0,*)PD(1,JJ+1)/100.,' ',PD(2,JJ+1)/100.
483 WRITE(0,*)' ',PD(1,JJ)/100.
484 WRITE(0,*)PD(1,JJ-1)/100,' ',PD(2,JJ-1)/100.
485 WRITE(0,*)
486 ENDIF
487
488 ENDIF
489 !
490 ENDDO
491 ENDIF
492 !
493 !*** ONE ROW WEST OF EASTERN BOUNDARY
494 !
495 IF(E_BDY)THEN
496 DO J=4,JM-3,2
497 !
498 IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
499 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
500 JJ=J
501 SHTM=HTM(IIM-1,KTE,JJ-1)+HTM(IIM,KTE,JJ-1) &
502 & +HTM(IIM-1,KTE,JJ+1)+HTM(IIM,KTE,JJ+1)
503 PD(IIM-1,JJ)=(PD(IIM-1,JJ-1)*HTM(IIM-1,KTE,JJ-1) &
504 & +PD(IIM,JJ-1)*HTM(IIM,KTE,JJ-1) &
505 & +PD(IIM-1,JJ+1)*HTM(IIM-1,KTE,JJ+1) &
506 & +PD(IIM,JJ+1)*HTM(IIM,KTE,JJ+1))/SHTM
507 ENDIF
508 !
509 ENDDO
510 ENDIF
511 !
512 !-----------------------------------------------------------------------
513 !
514 !$omp parallel do &
515 !$omp& private(i,j,jj,k,rhtm)
516 DO 200 K=KTS,KTE
517 !
518 !-----------------------------------------------------------------------
519 !
520 !*** ONE ROW NORTH OF SOUTHERN BOUNDARY
521 !
522 IF(S_BDY)THEN
523 DO I=MYIS,MYIE1
524 RHTM=1./(HTM(I,K,1)+HTM(I+1,K,1)+HTM(I,K,3)+HTM(I+1,K,3))
525 T(I,K,2)=(T(I,K,1)*HTM(I,K,1)+T(I+1,K,1)*HTM(I+1,K,1) &
526 & +T(I,K,3)*HTM(I,K,3)+T(I+1,K,3)*HTM(I+1,K,3)) &
527 & *RHTM
528 Q(I,K,2)=(Q(I,K,1)*HTM(I,K,1)+Q(I+1,K,1)*HTM(I+1,K,1) &
529 & +Q(I,K,3)*HTM(I,K,3)+Q(I+1,K,3)*HTM(I+1,K,3)) &
530 & *RHTM
531 Q2(I,K,2)=(Q2(I,K,1)*HTM(I,K,1)+Q2(I+1,K,1)*HTM(I+1,K,1) &
532 & +Q2(I,K,3)*HTM(I,K,3)+Q2(I+1,K,3)*HTM(I+1,K,3)) &
533 & *RHTM
534 CWM(I,K,2)=(CWM(I,K,1)*HTM(I,K,1)+CWM(I+1,K,1)*HTM(I+1,K,1) &
535 & +CWM(I,K,3)*HTM(I,K,3)+CWM(I+1,K,3)*HTM(I+1,K,3)) &
536 & *RHTM
537 PINT(I,K,2)=ETA1(K)*PDTOP+ETA2(K)*PD(I,2)*RES(I,2)+PT
538 ENDDO
539 DO I_M=1,N_MOIST
540 IF(I_M==P_QV)THEN
541 DO I=MYIS,MYIE1
542 MOIST(I,K,2,I_M)=Q(I,K,2)/(1.-Q(I,K,2))
543 ENDDO
544 ELSE
545 DO I=MYIS,MYIE1
546 MOIST(I,K,2,I_M)=(MOIST(I,K,1,I_M)*HTM(I,K,1) &
547 & +MOIST(I+1,K,1,I_M)*HTM(I+1,K,1) &
548 & +MOIST(I,K,3,I_M)*HTM(I,K,3) &
549 & +MOIST(I+1,K,3,I_M)*HTM(I+1,K,3)) &
550 & *RHTM
551 ENDDO
552 ENDIF
553 ENDDO
554 !
555 DO I_M=2,N_SCALAR
556 DO I=MYIS,MYIE1
557 SCALAR(I,K,2,I_M)=(SCALAR(I,K,1,I_M)*HTM(I,K,1) &
558 & +SCALAR(I+1,K,1,I_M)*HTM(I+1,K,1) &
559 & +SCALAR(I,K,3,I_M)*HTM(I,K,3) &
560 & +SCALAR(I+1,K,3,I_M)*HTM(I+1,K,3)) &
561 & *RHTM
562 ENDDO
563 ENDDO
564 !
565 ENDIF
566 !
567 !*** ONE ROW SOUTH OF NORTHERN BOUNDARY
568 !
569 IF(N_BDY)THEN
570 DO I=MYIS,MYIE1
571 RHTM=1./(HTM(I,K,JJM-2)+HTM(I+1,K,JJM-2) &
572 & +HTM(I,K,JJM)+HTM(I+1,K,JJM))
573 T(I,K,JJM-1)=(T(I,K,JJM-2)*HTM(I,K,JJM-2) &
574 & +T(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) &
575 & +T(I,K,JJM)*HTM(I,K,JJM) &
576 & +T(I+1,K,JJM)*HTM(I+1,K,JJM)) &
577 & *RHTM
578 Q(I,K,JJM-1)=(Q(I,K,JJM-2)*HTM(I,K,JJM-2) &
579 & +Q(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) &
580 & +Q(I,K,JJM)*HTM(I,K,JJM) &
581 & +Q(I+1,K,JJM)*HTM(I+1,K,JJM)) &
582 & *RHTM
583 Q2(I,K,JJM-1)=(Q2(I,K,JJM-2)*HTM(I,K,JJM-2) &
584 & +Q2(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) &
585 & +Q2(I,K,JJM)*HTM(I,K,JJM) &
586 & +Q2(I+1,K,JJM)*HTM(I+1,K,JJM)) &
587 & *RHTM
588 CWM(I,K,JJM-1)=(CWM(I,K,JJM-2)*HTM(I,K,JJM-2) &
589 & +CWM(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) &
590 & +CWM(I,K,JJM)*HTM(I,K,JJM) &
591 & +CWM(I+1,K,JJM)*HTM(I+1,K,JJM)) &
592 & *RHTM
593 PINT(I,K,JJM-1)=ETA1(K)*PDTOP &
594 & +ETA2(K)*PD(I,JJM-1)*RES(I,JJM-1)+PT
595 ENDDO
596 DO I_M=1,N_MOIST
597 IF(I_M==P_QV)THEN
598 DO I=MYIS,MYIE1
599 MOIST(I,K,JJM-1,I_M)=Q(I,K,JJM-1)/(1.-Q(I,K,JJM-1))
600 ENDDO
601 ELSE
602 DO I=MYIS,MYIE1
603 MOIST(I,K,JJM-1,I_M)=(MOIST(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) &
604 & +MOIST(I+1,K,JJM-2,I_M)*HTM(I+1,K,JJM-2) &
605 & +MOIST(I,K,JJM,I_M)*HTM(I,K,JJM) &
606 & +MOIST(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) &
607 & *RHTM
608 ENDDO
609
610 ENDIF
611 ENDDO
612 !
613 DO I_M=2,N_SCALAR
614 DO I=MYIS,MYIE1
615 SCALAR(I,K,JJM-1,I_M)=(SCALAR(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) &
616 & +SCALAR(I+1,K,JJM-2,I_m)*HTM(I+1,K,JJM-2) &
617 & +SCALAR(I,K,JJM,I_M)*HTM(I,K,JJM) &
618 & +SCALAR(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) &
619 & *RHTM
620 ENDDO
621 ENDDO
622 !
623 ENDIF
624 !
625 !*** ONE ROW EAST OF WESTERN BOUNDARY
626 !
627 IF(W_BDY)THEN
628 DO J=4,JM-3,2
629 !
630 IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
631 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
632 JJ=J
633 RHTM=1./(HTM(1,K,JJ-1)+HTM(2,K,JJ-1) &
634 & +HTM(1,K,JJ+1)+HTM(2,K,JJ+1))
635 T(1,K,JJ)=(T(1,K,JJ-1)*HTM(1,K,JJ-1) &
636 & +T(2,K,JJ-1)*HTM(2,K,JJ-1) &
637 & +T(1,K,JJ+1)*HTM(1,K,JJ+1) &
638 & +T(2,K,JJ+1)*HTM(2,K,JJ+1)) &
639 & *RHTM
640 Q(1,K,JJ)=(Q(1,K,JJ-1)*HTM(1,K,JJ-1) &
641 & +Q(2,K,JJ-1)*HTM(2,K,JJ-1) &
642 & +Q(1,K,JJ+1)*HTM(1,K,JJ+1) &
643 & +Q(2,K,JJ+1)*HTM(2,K,JJ+1)) &
644 & *RHTM
645 Q2(1,K,JJ)=(Q2(1,K,JJ-1)*HTM(1,K,JJ-1) &
646 & +Q2(2,K,JJ-1)*HTM(2,K,JJ-1) &
647 & +Q2(1,K,JJ+1)*HTM(1,K,JJ+1) &
648 & +Q2(2,K,JJ+1)*HTM(2,K,JJ+1)) &
649 & *RHTM
650 CWM(1,K,JJ)=(CWM(1,K,JJ-1)*HTM(1,K,JJ-1) &
651 & +CWM(2,K,JJ-1)*HTM(2,K,JJ-1) &
652 & +CWM(1,K,JJ+1)*HTM(1,K,JJ+1) &
653 & +CWM(2,K,JJ+1)*HTM(2,K,JJ+1)) &
654 & *RHTM
655 PINT(1,K,JJ)=ETA1(K)*PDTOP &
656 & +ETA2(K)*PD(1,JJ)*RES(1,JJ)+PT
657 DO I_M=1,N_MOIST
658 IF(I_M==P_QV)THEN
659 MOIST(1,K,JJ,I_M)=Q(1,K,JJ)/(1.-Q(1,K,JJ))
660 ELSE
661 MOIST(1,K,JJ,I_M)=(MOIST(1,K,JJ-1,I_M)*HTM(1,K,JJ-1) &
662 & +MOIST(2,K,JJ-1,I_M)*HTM(2,K,JJ-1) &
663 & +MOIST(1,K,JJ+1,I_M)*HTM(1,K,JJ+1) &
664 & +MOIST(2,K,JJ+1,I_M)*HTM(2,K,JJ+1)) &
665 & *RHTM
666 ENDIF
667 ENDDO
668 !
669 DO I_M=2,N_SCALAR
670 SCALAR(1,K,JJ,I_M)=(SCALAR(1,K,JJ-1,I_M)*HTM(1,K,JJ-1) &
671 & +SCALAR(2,K,JJ-1,I_M)*HTM(2,K,JJ-1) &
672 & +SCALAR(1,K,JJ+1,I_M)*HTM(1,K,JJ+1) &
673 & +SCALAR(2,K,JJ+1,I_M)*HTM(2,K,JJ+1)) &
674 & *RHTM
675 ENDDO
676 !
677 ENDIF
678 !
679 ENDDO
680 !
681 ENDIF
682 !
683 !*** ONE ROW WEST OF EASTERN BOUNDARY
684 !
685 IF(E_BDY)THEN
686 DO J=4,JM-3,2
687 !
688 IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
689 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
690 JJ=J
691 RHTM=1./(HTM(IIM-1,K,JJ-1)+HTM(IIM,K,JJ-1) &
692 & +HTM(IIM-1,K,JJ+1)+HTM(IIM,K,JJ+1))
693 T(IIM-1,K,JJ)=(T(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) &
694 & +T(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) &
695 & +T(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) &
696 & +T(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) &
697 & *RHTM
698 Q(IIM-1,K,JJ)=(Q(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) &
699 & +Q(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) &
700 & +Q(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) &
701 & +Q(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) &
702 & *RHTM
703 Q2(IIM-1,K,JJ)=(Q2(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) &
704 & +Q2(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) &
705 & +Q2(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) &
706 & +Q2(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) &
707 & *RHTM
708 CWM(IIM-1,K,JJ)=(CWM(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) &
709 & +CWM(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) &
710 & +CWM(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) &
711 & +CWM(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) &
712 & *RHTM
713 PINT(IIM-1,K,JJ)=ETA1(K)*PDTOP &
714 & +ETA2(K)*PD(IIM-1,JJ)*RES(IIM-1,JJ)+PT
715 !
716 DO I_M=1,N_MOIST
717 IF(I_M==P_QV)THEN
718 MOIST(IIM-1,K,JJ,I_M)=Q(IIM-1,K,JJ)/(1.-Q(IIM-1,K,JJ))
719 ELSE
720 MOIST(IIM-1,K,JJ,I_M)=(MOIST(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1) &
721 & +MOIST(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1) &
722 & +MOIST(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1) &
723 & +MOIST(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1)) &
724 & *RHTM
725 ENDIF
726 ENDDO
727 !
728 DO I_M=2,N_SCALAR
729 SCALAR(IIM-1,K,JJ,I_M)=(SCALAR(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1) &
730 & +SCALAR(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1) &
731 & +SCALAR(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1) &
732 & +SCALAR(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1)) &
733 & *RHTM
734 ENDDO
735 !
736 ENDIF
737 !
738 ENDDO
739 ENDIF
740 !-----------------------------------------------------------------------
741 !
742 200 CONTINUE
743 !
744 !-----------------------------------------------------------------------
745 END SUBROUTINE BOCOH
746 !-----------------------------------------------------------------------
747 !***********************************************************************
748 SUBROUTINE BOCOV(GRIDID,NTSD,DT,LB,VTM,U_B,V_B,U_BT,V_BT &
749 & ,U,V &
750 & ,IJDS,IJDE,SPEC_BDY_WIDTH & ! min/max(id,jd)
751 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
752 & ,IDS,IDE,JDS,JDE,KDS,KDE &
753 & ,IMS,IME,JMS,JME,KMS,KME &
754 & ,ITS,ITE,JTS,JTE,KTS,KTE)
755 !***********************************************************************
756 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
757 ! . . .
758 ! SUBPROGRAM: BOCOV UPDATE WIND POINTS ON BOUNDARY
759 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
760 !
761 ! ABSTRACT:
762 ! U AND V COMPONENTS OF THE WIND ARE UPDATED ON THE
763 ! DOMAIN BOUNDARY BY APPLYING THE PRE-COMPUTED
764 ! TENDENCIES AT EACH TIME STEP. AN EXTRAPOLATION FROM
765 ! INSIDE THE DOMAIN IS USED FOR THE COMPONENT TANGENTIAL
766 ! TO THE BOUNDARY IF THE NORMAL COMPONENT IS OUTWARD.
767 !
768 ! PROGRAM HISTORY LOG:
769 ! 87-??-?? MESINGER - ORIGINATOR
770 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
771 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
772 ! 01-03-13 BLACK - CONVERTED TO WRF STRUCTURE
773 ! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING
774 ! 04-11-23 BLACK - THREADED
775 !
776 ! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
777 ! INPUT ARGUMENT LIST:
778 !
779 ! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
780 ! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
781 ! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
782 !
783 ! OUTPUT ARGUMENT LIST:
784 !
785 ! OUTPUT FILES:
786 ! NONE
787 !
788 ! SUBPROGRAMS CALLED:
789 !
790 ! UNIQUE: NONE
791 !
792 ! LIBRARY: NONE
793 !
794 ! ATTRIBUTES:
795 ! LANGUAGE: FORTRAN 90
796 ! MACHINE : IBM
797 !$$$
798 !***********************************************************************
799 !-----------------------------------------------------------------------
800 !
801 IMPLICIT NONE
802 !
803 !-----------------------------------------------------------------------
804 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
805 & ,IMS,IME,JMS,JME,KMS,KME &
806 & ,ITS,ITE,JTS,JTE,KTS,KTE
807 INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH
808 !
809 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
810 !-----------------------------------------------------------------------
811 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
812 ! NMM_MAX_DIM is set in configure.wrf and must agree with
813 ! the value of dimspec q in the Registry/Registry
814 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
815 !-----------------------------------------------------------------------
816 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
817 !
818 INTEGER,INTENT(IN) :: GRIDID
819 INTEGER,INTENT(IN) :: LB,NTSD
820 !
821 REAL,INTENT(IN) :: DT
822 !
823 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: VTM
824 !
825 REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4),INTENT(INOUT) &
826 & :: U_B,V_B,U_BT,V_BT
827 !
828 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V
829 !-----------------------------------------------------------------------
830 !
831 !*** LOCAL VARIABLES
832 !
833 INTEGER :: I,II,IIM,IM,J,JJ,JJM,JM,K,N
834 INTEGER :: MY_IS_GLB, MY_JS_GLB,MY_IE_GLB,MY_JE_GLB
835 INTEGER :: IBDY,BF,JB,IB
836 INTEGER :: ILPAD1,IRPAD1,JBPAD1,JTPAD1
837 LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
838 !-----------------------------------------------------------------------
839 !***********************************************************************
840 !-----------------------------------------------------------------------
841 !
842 !-----------------------------------------------------------------------
843 !*** TIME INTERPOLATION OF U AND V AT THE OUTER BOUNDARY
844 !-----------------------------------------------------------------------
845 !
846 IM=IDE-IDS+1
847 JM=JDE-JDS+1
848 IIM=IM
849 JJM=JM
850 !
851 W_BDY=(ITS==IDS)
852 E_BDY=(ITE==IDE)
853 S_BDY=(JTS==JDS)
854 N_BDY=(JTE==JDE)
855 !
856 ILPAD1=1
857 IF(ITS==IDS)ILPAD1=0
858 IRPAD1=1
859 IF(ITE==IDE)ILPAD1=0
860 JBPAD1=1
861 IF(JTS==JDS)JBPAD1=0
862 JTPAD1=1
863 IF(JTE==JDE)JTPAD1=0
864 !
865 MY_IS_GLB=ITS
866 MY_IE_GLB=ITE
867 MY_JS_GLB=JTS
868 MY_JE_GLB=JTE
869 !
870 !-----------------------------------------------------------------------
871 !*** SOUTH AND NORTH BOUNDARIES
872 !*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH.
873 !-----------------------------------------------------------------------
874 !
875 DO IBDY=1,2
876 !
877 !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
878 !
879 IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN
880 !
881 IF(IBDY==1)THEN
882 BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start)
883 JB=1 ! Which cell in from Boundary
884 JJ=1 ! Which cell in the Domain
885 ELSE
886 BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end)
887 JB=1 ! Which cell in from Boundary
888 JJ=JJM ! Which cell in the Domain
889 ENDIF
890 !
891 !$omp parallel do &
892 !$omp& private(i,k)
893 DO K=KTS,KTE
894 DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
895 U_B(I,K,JB,BF)=U_B(I,K,JB,BF)+U_BT(I,K,JB,BF)*DT
896 V_B(I,K,JB,BF)=V_B(I,K,JB,BF)+V_BT(I,K,JB,BF)*DT
897 U(I,K,JJ)=U_B(I,K,JB,BF)
898 V(I,K,JJ)=V_B(I,K,JB,BF)
899 ENDDO
900 ENDDO
901 !
902 ENDIF
903 ENDDO
904
905 !
906 !-----------------------------------------------------------------------
907 !*** WEST AND EAST BOUNDARIES
908 !*** USE IBDY=1 FOR WEST; 2 FOR EAST.
909 !-----------------------------------------------------------------------
910 !
911 DO IBDY=1,2
912 !
913 !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
914 !
915 IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN
916 !
917 IF(IBDY==1)THEN
918 BF=P_XSB ! Which boundary (YSB=the boundary where Y is at its start)
919 IB=1 ! Which cell in from boundary
920 II=1 ! Which cell in the domain
921 ELSE
922 BF=P_XEB ! Which boundary (YEB=the boundary where Y is at its end)
923 IB=1 ! Which cell in from boundary
924 II=IIM ! Which cell in the domain
925 ENDIF
926 !
927 !$omp parallel do &
928 !$omp& private(j,k)
929 DO K=KTS,KTE
930 DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
931 IF(MOD(J,2)==0)THEN
932 U_B(J,K,IB,BF)=U_B(J,K,IB,BF)+U_BT(J,K,IB,BF)*DT
933 V_B(J,K,IB,BF)=V_B(J,K,IB,BF)+V_BT(J,K,IB,BF)*DT
934 U(II,K,J)=U_B(J,K,IB,BF)
935 V(II,K,J)=V_B(J,K,IB,BF)
936 ENDIF
937 ENDDO
938 ENDDO
939 !
940 ENDIF
941 ENDDO
942
943 !
944 !-----------------------------------------------------------------------
945 !*** EXTRAPOLATION OF TANGENTIAL VELOCITY AT OUTFLOW POINTS
946 !*** BASED ON SOME DISCUSSIONS WITH ZAVISA AND EXPERIMENTS
947 !*** ON GRAVITY PULSE FOR NESTED DOMAIN.
948 !-----------------------------------------------------------------------
949 !
950 IF(GRIDID/=1)GO TO 201
951 !
952 !-----------------------------------------------------------------------
953 !
954 !$omp parallel do &
955 !$omp& private(i,j,jj,k)
956 DO 200 K=KTS,KTE
957 !
958 !-----------------------------------------------------------------------
959 !
960 !*** SOUTHERN BOUNDARY
961 !
962 IF(S_BDY)THEN
963 DO I=MYIS1_P1,MYIE2_P1
964 IF(V(I,K,1)<0.)U(I,K,1)=(VTM(I,K,5)+1.)*U(I,K,3) &
965 & -VTM(I,K,5) *U(I,K,5)
966 ENDDO
967 ENDIF
968 !
969 !*** NORTHERN BOUNDARY
970 !
971 IF(N_BDY)THEN
972 DO I=MYIS1_P1,MYIE2_P1
973 IF(V(I,K,JJM)>0.) &
974 & U(I,K,JJM)=(VTM(I,K,JJM-4)+1.)*U(I,K,JJM-2) &
975 & -VTM(I,K,JJM-4) *U(I,K,JJM-4)
976 ENDDO
977 ENDIF
978 !
979 !*** WESTERN BOUNDARY
980 !
981 DO J=4,JM-3,2
982 IF(W_BDY)THEN
983 !
984 IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
985 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
986 JJ=J
987 IF(U(1,K,JJ)<0.) &
988 & V(1,K,JJ)=(VTM(3,K,JJ)+1.)*V(2,K,JJ) &
989 & -VTM(3,K,JJ) *V(3,K,JJ)
990 ENDIF
991 !
992 ENDIF
993 ENDDO
994 !
995 !*** EASTERN BOUNDARY
996 !
997 DO J=4,JM-3,2
998 IF(E_BDY)THEN
999 !
1000 IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
1001 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
1002 JJ=J
1003 IF(U(IIM,K,JJ)>0.) &
1004 & V(IIM,K,JJ)=(VTM(IIM-2,K,JJ)+1.)*V(IIM-1,K,JJ) &
1005 & -VTM(IIM-2,K,JJ) *V(IIM-2,K,JJ)
1006 ENDIF
1007 !
1008 ENDIF
1009 ENDDO
1010 !-----------------------------------------------------------------------
1011 !
1012 200 CONTINUE
1013
1014 201 CONTINUE
1015 !
1016 !-----------------------------------------------------------------------
1017 !
1018 !-----------------------------------------------------------------------
1019 !*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
1020 !-----------------------------------------------------------------------
1021 !
1022 !-----------------------------------------------------------------------
1023 !
1024 !$omp parallel do &
1025 !$omp& private(i,j,jj,k)
1026 DO 300 K=KTS,KTE
1027 !
1028 !-----------------------------------------------------------------------
1029 !
1030 !*** SOUTHWEST CORNER
1031 !
1032 IF(S_BDY.AND.W_BDY)THEN
1033 U(2,K,2)=D06666*(4.*(U(1,K,1)+U(2,K,1)+U(2,K,3)) &
1034 & + U(1,K,2)+U(1,K,4)+U(2,K,4))
1035 V(2,K,2)=D06666*(4.*(V(1,K,1)+V(2,K,1)+V(2,K,3)) &
1036 & +V(1,K,2)+V(1,K,4)+V(2,K,4))
1037 ENDIF
1038 !
1039 !*** SOUTHEAST CORNER
1040 !
1041 IF(S_BDY.AND.E_BDY)THEN
1042 U(IIM-1,K,2)=D06666*(4.*(U(IIM-2,K,1)+U(IIM-1,K,1) &
1043 & +U(IIM-2,K,3)) &
1044 & +U(IIM,K,2)+U(IIM,K,4)+U(IIM-1,K,4))
1045 V(IIM-1,K,2)=D06666*(4.*(V(IIM-2,K,1)+V(IIM-1,K,1) &
1046 & +V(IIM-2,K,3)) &
1047 & +V(IIM,K,2)+V(IIM,K,4)+V(IIM-1,K,4))
1048 ENDIF
1049 !
1050 !*** NORTHWEST CORNER
1051 !
1052 IF(N_BDY.AND.W_BDY)THEN
1053 U(2,K,JJM-1)=D06666*(4.*(U(1,K,JJM)+U(2,K,JJM)+U(2,K,JJM-2)) &
1054 & +U(1,K,JJM-1)+U(1,K,JJM-3) &
1055 & +U(2,K,JJM-3))
1056 V(2,K,JJM-1)=D06666*(4.*(V(1,K,JJM)+V(2,K,JJM)+V(2,K,JJM-2)) &
1057 & +V(1,K,JJM-1)+V(1,K,JJM-3) &
1058 & +V(2,K,JJM-3))
1059 ENDIF
1060 !
1061 !*** NORTHEAST CORNER
1062 !
1063 IF(N_BDY.AND.E_BDY)THEN
1064 U(IIM-1,K,JJM-1)= &
1065 & D06666*(4.*(U(IIM-2,K,JJM)+U(IIM-1,K,JJM)+U(IIM-2,K,JJM-2)) &
1066 & +U(IIM,K,JJM-1)+U(IIM,K,JJM-3)+U(IIM-1,K,JJM-3))
1067 V(IIM-1,K,JJM-1)= &
1068 & D06666*(4.*(V(IIM-2,K,JJM)+V(IIM-1,K,JJM)+V(IIM-2,K,JJM-2)) &
1069 & +V(IIM,K,JJM-1)+V(IIM,K,JJM-3)+V(IIM-1,K,JJM-3))
1070 ENDIF
1071 !
1072 !-----------------------------------------------------------------------
1073 !*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
1074 !-----------------------------------------------------------------------
1075 !
1076 !*** ONE ROW NORTH OF SOUTHERN BOUNDARY
1077 !
1078 IF(S_BDY)THEN
1079 DO I=MYIS2,MYIE2
1080 U(I,K,2)=(U(I-1,K,1)+U(I,K,1)+U(I-1,K,3)+U(I,K,3))*0.25
1081 V(I,K,2)=(V(I-1,K,1)+V(I,K,1)+V(I-1,K,3)+V(I,K,3))*0.25
1082 ENDDO
1083 ENDIF
1084 !
1085 !*** ONE ROW SOUTH OF NORTHERN BOUNDARY
1086 !
1087 IF(N_BDY)THEN
1088 DO I=MYIS2,MYIE2
1089 U(I,K,JJM-1)=(U(I-1,K,JJM-2)+U(I,K,JJM-2) &
1090 & +U(I-1,K,JJM)+U(I,K,JJM))*0.25
1091 V(I,K,JJM-1)=(V(I-1,K,JJM-2)+V(I,K,JJM-2) &
1092 & +V(I-1,K,JJM)+V(I,K,JJM))*0.25
1093 ENDDO
1094 ENDIF
1095 !
1096 !*** ONE ROW EAST OF WESTERN BOUNDARY
1097 !
1098 DO J=3,JM-2,2
1099 IF(W_BDY)THEN
1100 IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
1101 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
1102 JJ=J
1103 U(1,K,JJ)=(U(1,K,JJ-1)+U(2,K,JJ-1) &
1104 & +U(1,K,JJ+1)+U(2,K,JJ+1))*0.25
1105 V(1,K,JJ)=(V(1,K,JJ-1)+V(2,K,JJ-1) &
1106 & +V(1,K,JJ+1)+V(2,K,JJ+1))*0.25
1107 ENDIF
1108 ENDIF
1109 ENDDO
1110 !
1111 !*** ONE ROW WEST OF EASTERN BOUNDARY
1112 !
1113 IF(E_BDY)THEN
1114 DO J=3,JM-2,2
1115 IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
1116 & .AND.J<=MY_JE_GLB+JTPAD1)THEN
1117 JJ=J
1118 U(IIM-1,K,JJ)=0.25*(U(IIM-1,K,JJ-1)+U(IIM,K,JJ-1) &
1119 & +U(IIM-1,K,JJ+1)+U(IIM,K,JJ+1))
1120 V(IIM-1,K,JJ)=0.25*(V(IIM-1,K,JJ-1)+V(IIM,K,JJ-1) &
1121 & +V(IIM-1,K,JJ+1)+V(IIM,K,JJ+1))
1122 ENDIF
1123 ENDDO
1124 ENDIF
1125 !-----------------------------------------------------------------------
1126 !
1127 300 CONTINUE
1128 !
1129 !-----------------------------------------------------------------------
1130 END SUBROUTINE BOCOV
1131 !-----------------------------------------------------------------------
1132
1133 !-----------------------------------------------------------------------
1134 END MODULE MODULE_BNDRY_COND
1135 !-----------------------------------------------------------------------