| [2759] | 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 | !----------------------------------------------------------------------- |
|---|
