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