| 1 | !----------------------------------------------------------------------- |
|---|
| 2 | ! |
|---|
| 3 | MODULE MODULE_BL_QNSEPBL |
|---|
| 4 | ! |
|---|
| 5 | !----------------------------------------------------------------------- |
|---|
| 6 | ! |
|---|
| 7 | USE MODULE_MODEL_CONSTANTS |
|---|
| 8 | ! |
|---|
| 9 | !----------------------------------------------------------------------- |
|---|
| 10 | ! |
|---|
| 11 | ! REFERENCES: Janjic (2002), NCEP Office Note 437 |
|---|
| 12 | ! Mellor and Yamada (1982), Rev. Geophys. Space Phys. |
|---|
| 13 | ! |
|---|
| 14 | ! ABSTRACT: |
|---|
| 15 | ! MYJ UPDATES THE TURBULENT KINETIC ENERGY WITH THE PRODUCTION/ |
|---|
| 16 | ! DISSIPATION TERM AND THE VERTICAL DIFFUSION TERM |
|---|
| 17 | ! (USING AN IMPLICIT FORMULATION) FROM MELLOR-YAMADA |
|---|
| 18 | ! LEVEL 2.5 AS EXTENDED BY JANJIC. EXCHANGE COEFFICIENTS FOR |
|---|
| 19 | ! THE SURFACE AND FOR ALL LAYER INTERFACES ARE COMPUTED FROM |
|---|
| 20 | ! MONIN-OBUKHOV THEORY. |
|---|
| 21 | ! THE TURBULENT VERTICAL EXCHANGE IS THEN EXECUTED. |
|---|
| 22 | ! |
|---|
| 23 | !----------------------------------------------------------------------- |
|---|
| 24 | ! |
|---|
| 25 | INTEGER :: ITRMX=5 ! Iteration count for mixing length computation |
|---|
| 26 | ! |
|---|
| 27 | ! REAL,PARAMETER :: G=9.81,PI=3.1415926,R_D=287.04,R_V=461.6 & |
|---|
| 28 | ! & ,VKARMAN=0.4 |
|---|
| 29 | REAL,PARAMETER :: PI=3.1415926,VKARMAN=0.4 |
|---|
| 30 | ! |
|---|
| 31 | !----------------------------------------------------------------------- |
|---|
| 32 | !*** QNSE MODEL CONSTANTS |
|---|
| 33 | !----------------------------------------------------------------------- |
|---|
| 34 | ! |
|---|
| 35 | REAL,PARAMETER :: EPSQ2L=0.01 |
|---|
| 36 | REAL,PARAMETER :: C0=0.55,CEPS=C0**3,BLCKDR=0.0063,CN=0.75 & |
|---|
| 37 | & ,AM1=8.0,AM2=2.3,AM3=35.0,AH1=1.4,AH2=-0.01 & |
|---|
| 38 | & ,AH3=1.29,AH4=2.44,AH5=19.8 & |
|---|
| 39 | & ,ARIMIN=0.127,BM1=2.88,BM2=16.0,BH1=3.6,BH2=16.0 & |
|---|
| 40 | & ,BH3=720.0,EPSKM=1.E-3 |
|---|
| 41 | ! |
|---|
| 42 | REAL,PARAMETER :: CAPA=R_D/CP |
|---|
| 43 | REAL,PARAMETER :: RLIVWV=XLS/XLV,ELOCP=2.72E6/CP |
|---|
| 44 | REAL,PARAMETER :: EPS1=1.E-12,EPS2=0. |
|---|
| 45 | REAL,PARAMETER :: EPSL=0.32,EPSRU=1.E-7,EPSRS=1.E-7 & |
|---|
| 46 | & ,EPSTRB=1.E-24 |
|---|
| 47 | REAL,PARAMETER :: EPSA=1.E-8,EPSIT=1.E-4,EPSU2=1.E-4,EPSUST=0.07 & |
|---|
| 48 | & ,FH=1.01 |
|---|
| 49 | REAL,PARAMETER :: ALPH=0.30,BETA=1./273.,EL0MAX=1000.,EL0MIN=1. & |
|---|
| 50 | & ,ELFC=0.23*0.5,GAM1=0.2222222222222222222 & |
|---|
| 51 | & ,PRT=1. |
|---|
| 52 | REAL,PARAMETER :: A1=0.659888514560862645 & |
|---|
| 53 | & ,A2x=0.6574209922667784586 & |
|---|
| 54 | & ,B1=11.87799326209552761 & |
|---|
| 55 | & ,B2=7.226971804046074028 & |
|---|
| 56 | & ,C1=0.000830955950095854396 |
|---|
| 57 | REAL,PARAMETER :: A2S=17.2693882,A3S=273.16,A4S=35.86 |
|---|
| 58 | REAL,PARAMETER :: ELZ0=0.,ESQ=5.0,EXCM=0.001 & |
|---|
| 59 | & ,FHNEU=0.8,GLKBR=10.,GLKBS=30. & |
|---|
| 60 | & ,QVISC=2.1E-5,RFC=0.191,RIC=0.505,SMALL=0.35 & |
|---|
| 61 | & ,SQPR=0.84,SQSC=0.84,SQVISC=258.2,TVISC=2.1E-5 & |
|---|
| 62 | & ,USTC=0.7,USTR=0.225,VISC=1.5E-5 & |
|---|
| 63 | & ,WOLD=0.15,WWST=1.2,ZTMAX=1.,ZTFC=1.,ZTMIN=-5. |
|---|
| 64 | ! |
|---|
| 65 | REAL,PARAMETER :: SEAFC=0.98,PQ0SEA=PQ0*SEAFC |
|---|
| 66 | ! |
|---|
| 67 | REAL,PARAMETER :: BTG=BETA*G,CZIV=SMALL*GLKBS & |
|---|
| 68 | ! & ,EP_1=R_V/R_D-1.,ESQHF=0.5*5.0,GRRS=GLKBR/GLKBS & |
|---|
| 69 | & ,ESQHF=0.5*5.0,GRRS=GLKBR/GLKBS & |
|---|
| 70 | & ,RB1=1./B1,RTVISC=1./TVISC,RVISC=1./VISC & |
|---|
| 71 | & ,ZQRZT=SQSC/SQPR |
|---|
| 72 | ! |
|---|
| 73 | REAL,PARAMETER :: ADNH= 9.*A1*A2x*A2x*(12.*A1+3.*B2)*BTG*BTG & |
|---|
| 74 | & ,ADNM=18.*A1*A1*A2x*(B2-3.*A2x)*BTG & |
|---|
| 75 | & ,ANMH=-9.*A1*A2x*A2x*BTG*BTG & |
|---|
| 76 | & ,ANMM=-3.*A1*A2x*(3.*A2x+3.*B2*C1+18.*A1*C1-B2) & |
|---|
| 77 | & *BTG & |
|---|
| 78 | & ,BDNH= 3.*A2x*(7.*A1+B2)*BTG & |
|---|
| 79 | & ,BDNM= 6.*A1*A1 & |
|---|
| 80 | & ,BEQH= A2x*B1*BTG+3.*A2x*(7.*A1+B2)*BTG & |
|---|
| 81 | & ,BEQM=-A1*B1*(1.-3.*C1)+6.*A1*A1 & |
|---|
| 82 | & ,BNMH=-A2x*BTG & |
|---|
| 83 | & ,BNMM=A1*(1.-3.*C1) & |
|---|
| 84 | & ,BSHH=9.*A1*A2x*A2x*BTG & |
|---|
| 85 | & ,BSHM=18.*A1*A1*A2x*C1 & |
|---|
| 86 | & ,BSMH=-3.*A1*A2x*(3.*A2x+3.*B2*C1+12.*A1*C1-B2) & |
|---|
| 87 | & *BTG & |
|---|
| 88 | & ,CESH=A2x & |
|---|
| 89 | & ,CESM=A1*(1.-3.*C1) & |
|---|
| 90 | & ,CNV=EP_1*G/BTG & |
|---|
| 91 | & ,ELFCS=VKARMAN*BTG & |
|---|
| 92 | & ,FZQ1=RTVISC*QVISC*ZQRZT & |
|---|
| 93 | & ,FZQ2=RTVISC*QVISC*ZQRZT & |
|---|
| 94 | & ,FZT1=RVISC *TVISC*SQPR & |
|---|
| 95 | & ,FZT2=CZIV*GRRS*TVISC*SQPR & |
|---|
| 96 | & ,FZU1=CZIV*VISC & |
|---|
| 97 | & ,PIHF=0.5*PI & |
|---|
| 98 | & ,RFAC=RIC/(FHNEU*RFC*RFC) & |
|---|
| 99 | & ,RQVISC=1./QVISC & |
|---|
| 100 | & ,RRIC=1./RIC & |
|---|
| 101 | & ,USTFC=0.018/G & |
|---|
| 102 | & ,WNEW=1.-WOLD & |
|---|
| 103 | & ,WWST2=WWST*WWST |
|---|
| 104 | ! |
|---|
| 105 | !----------------------------------------------------------------------- |
|---|
| 106 | !*** FREE TERM IN THE EQUILIBRIUM EQUATION FOR (L/Q)**2 |
|---|
| 107 | !----------------------------------------------------------------------- |
|---|
| 108 | ! |
|---|
| 109 | REAL,PARAMETER :: AEQH=9.*A1*A2x*A2x*B1*BTG*BTG & |
|---|
| 110 | & +9.*A1*A2x*A2x*(12.*A1+3.*B2)*BTG*BTG & |
|---|
| 111 | & ,AEQM=3.*A1*A2x*B1*(3.*A2x+3.*B2*C1+18.*A1*C1-B2)& |
|---|
| 112 | & *BTG+18.*A1*A1*A2x*(B2-3.*A2x)*BTG |
|---|
| 113 | ! |
|---|
| 114 | !----------------------------------------------------------------------- |
|---|
| 115 | !*** FORBIDDEN TURBULENCE AREA |
|---|
| 116 | !----------------------------------------------------------------------- |
|---|
| 117 | ! |
|---|
| 118 | REAL,PARAMETER :: REQU=-AEQH/AEQM & |
|---|
| 119 | & ,EPSGH=1.E-9,EPSGM=REQU*EPSGH |
|---|
| 120 | ! |
|---|
| 121 | !----------------------------------------------------------------------- |
|---|
| 122 | !*** NEAR ISOTROPY FOR SHEAR TURBULENCE, WW/Q2 LOWER LIMIT |
|---|
| 123 | !----------------------------------------------------------------------- |
|---|
| 124 | ! |
|---|
| 125 | REAL,PARAMETER :: UBRYL=(18.*REQU*A1*A1*A2x*B2*C1*BTG & |
|---|
| 126 | & +9.*A1*A2x*A2x*B2*BTG*BTG) & |
|---|
| 127 | & /(REQU*ADNM+ADNH) & |
|---|
| 128 | & ,UBRY=(1.+EPSRS)*UBRYL,UBRY3=3.*UBRY |
|---|
| 129 | ! |
|---|
| 130 | REAL,PARAMETER :: AUBH=27.*A1*A2x*A2x*B2*BTG*BTG-ADNH*UBRY3 & |
|---|
| 131 | & ,AUBM=54.*A1*A1*A2x*B2*C1*BTG -ADNM*UBRY3 & |
|---|
| 132 | & ,BUBH=(9.*A1*A2x+3.*A2x*B2)*BTG-BDNH*UBRY3 & |
|---|
| 133 | & ,BUBM=18.*A1*A1*C1 -BDNM*UBRY3 & |
|---|
| 134 | & ,CUBR=1. - UBRY3 & |
|---|
| 135 | & ,RCUBR=1./CUBR |
|---|
| 136 | ! |
|---|
| 137 | !----------------------------------------------------------------------- |
|---|
| 138 | ! |
|---|
| 139 | CONTAINS |
|---|
| 140 | ! |
|---|
| 141 | !---------------------------------------------------------------------- |
|---|
| 142 | SUBROUTINE QNSEPBL(DT,STEPBL,HT,DZ & |
|---|
| 143 | & ,PMID,PINT,TH,T,EXNER,QV,CWM,U,V,RHO & |
|---|
| 144 | & ,TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0,CORF & |
|---|
| 145 | & ,LOWLYR,XLAND,SICE,SNOW & |
|---|
| 146 | & ,TKE,EXCH_H,EXCH_M,USTAR,ZNT,EL_MYJ,PBLH,KPBL,CT & |
|---|
| 147 | & ,AKHS,AKMS,ELFLX & |
|---|
| 148 | & ,RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN & |
|---|
| 149 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 150 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 151 | & ,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 152 | !---------------------------------------------------------------------- |
|---|
| 153 | ! |
|---|
| 154 | IMPLICIT NONE |
|---|
| 155 | ! |
|---|
| 156 | !---------------------------------------------------------------------- |
|---|
| 157 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 158 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 159 | & ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 160 | ! |
|---|
| 161 | INTEGER,INTENT(IN) :: STEPBL |
|---|
| 162 | |
|---|
| 163 | INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LOWLYR |
|---|
| 164 | ! |
|---|
| 165 | INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: KPBL |
|---|
| 166 | ! |
|---|
| 167 | REAL,INTENT(IN) :: DT |
|---|
| 168 | ! |
|---|
| 169 | REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT,SICE,SNOW & |
|---|
| 170 | & ,TSK,XLAND |
|---|
| 171 | ! |
|---|
| 172 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,DZ & |
|---|
| 173 | & ,EXNER & |
|---|
| 174 | & ,PMID,PINT & |
|---|
| 175 | & ,QV,RHO & |
|---|
| 176 | & ,T,TH,U,V |
|---|
| 177 | ! |
|---|
| 178 | REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PBLH |
|---|
| 179 | ! |
|---|
| 180 | REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: AKHS,AKMS |
|---|
| 181 | ! |
|---|
| 182 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) & |
|---|
| 183 | & ,INTENT(OUT) :: EL_MYJ & |
|---|
| 184 | & ,RQCBLTEN,RQVBLTEN & |
|---|
| 185 | & ,RTHBLTEN & |
|---|
| 186 | & ,RUBLTEN,RVBLTEN |
|---|
| 187 | ! |
|---|
| 188 | REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CT,QSFC,QZ0 & |
|---|
| 189 | & ,THZ0,USTAR & |
|---|
| 190 | & ,UZ0,VZ0,ZNT |
|---|
| 191 | ! |
|---|
| 192 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) & |
|---|
| 193 | & ,INTENT(INOUT) :: EXCH_H,EXCH_M,TKE |
|---|
| 194 | ! |
|---|
| 195 | REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CHKLOWQ,ELFLX,CORF |
|---|
| 196 | ! |
|---|
| 197 | !---------------------------------------------------------------------- |
|---|
| 198 | !*** |
|---|
| 199 | !*** LOCAL VARIABLES |
|---|
| 200 | !*** |
|---|
| 201 | INTEGER :: I,J,K,KFLIP,LLOW,LMH,LMXL |
|---|
| 202 | ! |
|---|
| 203 | INTEGER,DIMENSION(ITS:ITE,JTS:JTE) :: LPBL |
|---|
| 204 | ! |
|---|
| 205 | REAL :: AKHS_DENS,AKMS_DENS,APEX,DCDT,DELTAZ,DQDT,DTDIF,DTDT & |
|---|
| 206 | & ,DTTURBL,DUDT,DVDT,EXNSFC,PSFC,PTOP,QFC1,QLOW,QOLD & |
|---|
| 207 | & ,RATIOMX,RDTTURBL,RG,RWMSK,SEAMASK,THNEW,THOLD,TX & |
|---|
| 208 | & ,ULOW,VLOW,WMSK |
|---|
| 209 | ! |
|---|
| 210 | REAL,DIMENSION(KTS:KTE) :: CWMK,PK,Q2K,QK,THEK,TK,UK,VK |
|---|
| 211 | ! |
|---|
| 212 | REAL,DIMENSION(KTS:KTE-1) :: AKHK,AKMK,EL,RI,GH,S2 |
|---|
| 213 | ! |
|---|
| 214 | REAL,DIMENSION(KTS:KTE+1) :: ZHK |
|---|
| 215 | ! |
|---|
| 216 | REAL,DIMENSION(ITS:ITE,JTS:JTE) :: THSK |
|---|
| 217 | ! |
|---|
| 218 | REAL,DIMENSION(KTS:KTE,ITS:ITE) :: RHOK |
|---|
| 219 | ! |
|---|
| 220 | REAL,DIMENSION(ITS:ITE,KTS:KTE,JTS:JTE) :: APE,THE |
|---|
| 221 | ! |
|---|
| 222 | REAL,DIMENSION(ITS:ITE,KTS:KTE-1,JTS:JTE) :: AKH,AKM |
|---|
| 223 | ! |
|---|
| 224 | REAL,DIMENSION(ITS:ITE,KTS:KTE+1,JTS:JTE) :: ZINT |
|---|
| 225 | ! |
|---|
| 226 | !*** Begin debugging |
|---|
| 227 | REAL :: ZSL_DIAG |
|---|
| 228 | INTEGER :: IMD,JMD,PRINT_DIAG |
|---|
| 229 | !*** End debugging |
|---|
| 230 | ! |
|---|
| 231 | !---------------------------------------------------------------------- |
|---|
| 232 | !********************************************************************** |
|---|
| 233 | !---------------------------------------------------------------------- |
|---|
| 234 | ! |
|---|
| 235 | !*** Begin debugging |
|---|
| 236 | IMD=(IMS+IME)/2 |
|---|
| 237 | JMD=(JMS+JME)/2 |
|---|
| 238 | !*** End debugging |
|---|
| 239 | ! |
|---|
| 240 | !*** MAKE PREPARATIONS |
|---|
| 241 | ! |
|---|
| 242 | !---------------------------------------------------------------------- |
|---|
| 243 | DTTURBL=DT*STEPBL |
|---|
| 244 | RDTTURBL=1./DTTURBL |
|---|
| 245 | DTDIF=DTTURBL |
|---|
| 246 | RG=1./G |
|---|
| 247 | ! |
|---|
| 248 | DO J=JTS,JTE |
|---|
| 249 | DO K=KTS,KTE-1 |
|---|
| 250 | DO I=ITS,ITE |
|---|
| 251 | AKM(I,K,J)=0. |
|---|
| 252 | ENDDO |
|---|
| 253 | ENDDO |
|---|
| 254 | ENDDO |
|---|
| 255 | ! |
|---|
| 256 | DO J=JTS,JTE |
|---|
| 257 | DO K=KTS,KTE+1 |
|---|
| 258 | DO I=ITS,ITE |
|---|
| 259 | ZINT(I,K,J)=0. |
|---|
| 260 | ENDDO |
|---|
| 261 | ENDDO |
|---|
| 262 | ENDDO |
|---|
| 263 | ! |
|---|
| 264 | DO J=JTS,JTE |
|---|
| 265 | DO I=ITS,ITE |
|---|
| 266 | ZINT(I,KTE+1,J)=HT(I,J) ! Z at bottom of lowest sigma layer |
|---|
| 267 | ! |
|---|
| 268 | !!!!!!!!! |
|---|
| 269 | !!!!!! UNCOMMENT THESE LINES IF USING ETA COORDINATES |
|---|
| 270 | !!!!!!!!! |
|---|
| 271 | !!!!!! ZINT(I,KTE+1,J)=1.E-4 ! Z of bottom of lowest eta layer |
|---|
| 272 | !!!!!! ZHK(KTE+1)=1.E-4 ! Z of bottom of lowest eta layer |
|---|
| 273 | ! |
|---|
| 274 | ENDDO |
|---|
| 275 | ENDDO |
|---|
| 276 | ! |
|---|
| 277 | DO J=JTS,JTE |
|---|
| 278 | DO K=KTE,KTS,-1 |
|---|
| 279 | KFLIP=KTE+1-K |
|---|
| 280 | DO I=ITS,ITE |
|---|
| 281 | ZINT(I,K,J)=ZINT(I,K+1,J)+DZ(I,KFLIP,J) |
|---|
| 282 | APEX=1./EXNER(I,K,J) |
|---|
| 283 | APE(I,K,J)=APEX |
|---|
| 284 | TX=T(I,K,J) |
|---|
| 285 | THE(I,K,J)=(CWM(I,K,J)*(-ELOCP/TX)+1.)*TH(I,K,J) |
|---|
| 286 | ENDDO |
|---|
| 287 | ENDDO |
|---|
| 288 | ENDDO |
|---|
| 289 | ! |
|---|
| 290 | EL_MYJ(its:ite,:,jts:jte) = 0. |
|---|
| 291 | ! |
|---|
| 292 | !---------------------------------------------------------------------- |
|---|
| 293 | setup_integration: DO J=JTS,JTE |
|---|
| 294 | !---------------------------------------------------------------------- |
|---|
| 295 | ! |
|---|
| 296 | DO I=ITS,ITE |
|---|
| 297 | ! |
|---|
| 298 | !*** LOWEST LAYER ABOVE GROUND MUST BE FLIPPED |
|---|
| 299 | ! |
|---|
| 300 | LMH=KTE-LOWLYR(I,J)+1 |
|---|
| 301 | ! |
|---|
| 302 | PTOP=PINT(I,KTE+1,J) ! KTE+1=KME |
|---|
| 303 | PSFC=PINT(I,LOWLYR(I,J),J) |
|---|
| 304 | ! |
|---|
| 305 | !*** CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND) |
|---|
| 306 | ! |
|---|
| 307 | SEAMASK=XLAND(I,J)-1. |
|---|
| 308 | ! |
|---|
| 309 | !*** FILL 1-D VERTICAL ARRAYS |
|---|
| 310 | !*** AND FLIP DIRECTION SINCE MYJ SCHEME |
|---|
| 311 | !*** COUNTS DOWNWARD FROM THE DOMAIN'S TOP |
|---|
| 312 | ! |
|---|
| 313 | DO K=KTE,KTS,-1 |
|---|
| 314 | KFLIP=KTE+1-K |
|---|
| 315 | TK(K)=T(I,KFLIP,J) |
|---|
| 316 | THEK(K)=THE(I,KFLIP,J) |
|---|
| 317 | RATIOMX=QV(I,KFLIP,J) |
|---|
| 318 | QK(K)=RATIOMX/(1.+RATIOMX) |
|---|
| 319 | CWMK(K)=CWM(I,KFLIP,J) |
|---|
| 320 | PK(K)=PMID(I,KFLIP,J) |
|---|
| 321 | UK(K)=U(I,KFLIP,J) |
|---|
| 322 | VK(K)=V(I,KFLIP,J) |
|---|
| 323 | ! |
|---|
| 324 | !*** TKE=0.5*(q**2) ==> q**2=2.*TKE |
|---|
| 325 | ! |
|---|
| 326 | Q2K(K)=2.*TKE(I,KFLIP,J) |
|---|
| 327 | ! |
|---|
| 328 | !*** COMPUTE THE HEIGHTS OF THE LAYER INTERFACES |
|---|
| 329 | ! |
|---|
| 330 | ZHK(K)=ZINT(I,K,J) |
|---|
| 331 | ! |
|---|
| 332 | ENDDO |
|---|
| 333 | ZHK(KTE+1)=HT(I,J) ! Z at bottom of lowest sigma layer |
|---|
| 334 | ! |
|---|
| 335 | !*** Begin debugging |
|---|
| 336 | ! IF(I==IMD.AND.J==JMD)THEN |
|---|
| 337 | ! PRINT_DIAG=1 |
|---|
| 338 | ! ELSE |
|---|
| 339 | ! PRINT_DIAG=0 |
|---|
| 340 | ! ENDIF |
|---|
| 341 | ! IF(I==227.AND.J==363)PRINT_DIAG=2 |
|---|
| 342 | !*** End debugging |
|---|
| 343 | ! |
|---|
| 344 | !---------------------------------------------------------------------- |
|---|
| 345 | !*** |
|---|
| 346 | !*** FIND THE MIXING LENGTH |
|---|
| 347 | !*** |
|---|
| 348 | CALL MIXLEN(LMH,UK,VK,TK,THEK,QK,CWMK & |
|---|
| 349 | & ,Q2K,ZHK,USTAR(I,J),CORF(I,J),S2,GH,RI,EL & |
|---|
| 350 | & ,PBLH(I,J),LPBL(I,J),LMXL,CT(I,J) & |
|---|
| 351 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 352 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 353 | & ,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 354 | ! |
|---|
| 355 | !---------------------------------------------------------------------- |
|---|
| 356 | !*** THE MODEL LAYER (COUNTING UPWARD) CONTAINING THE TOP OF THE PBL |
|---|
| 357 | !---------------------------------------------------------------------- |
|---|
| 358 | ! |
|---|
| 359 | KPBL(I,J)=KTE-LPBL(I,J)+1 |
|---|
| 360 | ! |
|---|
| 361 | !---------------------------------------------------------------------- |
|---|
| 362 | !*** |
|---|
| 363 | !*** FIND THE QNSE EXCHANGE COEFFICIENTS |
|---|
| 364 | !*** |
|---|
| 365 | CALL DIFCOF(LMH,EL,RI,Q2K,ZHK,AKMK,AKHK & |
|---|
| 366 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 367 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 368 | & ,ITS,ITE,JTS,JTE,KTS,KTE,PRINT_DIAG) ! debug |
|---|
| 369 | ! |
|---|
| 370 | !---------------------------------------------------------------------- |
|---|
| 371 | !*** COUNTING DOWNWARD FROM THE TOP, THE EXCHANGE COEFFICIENTS AKH |
|---|
| 372 | !*** ARE DEFINED ON THE BOTTOMS OF THE LAYERS KTS TO KTE-1. COUNTING |
|---|
| 373 | !*** COUNTING UPWARD FROM THE BOTTOM, THOSE SAME COEFFICIENTS EXCH_H |
|---|
| 374 | !*** ARE DEFINED ON THE TOPS OF THE LAYERS KTS TO KTE-1. |
|---|
| 375 | ! |
|---|
| 376 | DO K=KTS,KTE-1 |
|---|
| 377 | KFLIP=KTE-K |
|---|
| 378 | AKH(I,K,J)=AKHK(K) |
|---|
| 379 | AKM(I,K,J)=AKMK(K) |
|---|
| 380 | DELTAZ=0.5*(ZHK(KFLIP)-ZHK(KFLIP+2)) |
|---|
| 381 | EXCH_H(I,K+1,J)=AKHK(KFLIP)*DELTAZ |
|---|
| 382 | EXCH_M(I,K+1,J)=AKMK(KFLIP)*DELTAZ |
|---|
| 383 | ENDDO |
|---|
| 384 | ! |
|---|
| 385 | !---------------------------------------------------------------------- |
|---|
| 386 | !*** |
|---|
| 387 | !*** SOLVE FOR THE PRODUCTION/DISSIPATION OF |
|---|
| 388 | !*** THE TURBULENT KINETIC ENERGY |
|---|
| 389 | !*** |
|---|
| 390 | ! |
|---|
| 391 | CALL PRODQ2(LMH,DTTURBL,USTAR(I,J),S2,RI,Q2K,EL,ZHK,AKMK,AKHK & |
|---|
| 392 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 393 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 394 | & ,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 395 | ! |
|---|
| 396 | !---------------------------------------------------------------------- |
|---|
| 397 | !*** |
|---|
| 398 | !*** CARRY OUT THE VERTICAL DIFFUSION OF |
|---|
| 399 | !*** TURBULENT KINETIC ENERGY |
|---|
| 400 | !*** |
|---|
| 401 | ! |
|---|
| 402 | CALL VDIFQ(LMH,DTDIF,Q2K,EL,ZHK & |
|---|
| 403 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 404 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 405 | & ,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 406 | ! |
|---|
| 407 | !*** SAVE THE NEW TKE AND MIXING LENGTH. |
|---|
| 408 | ! |
|---|
| 409 | DO K=KTS,KTE |
|---|
| 410 | KFLIP=KTE+1-K |
|---|
| 411 | Q2K(KFLIP)=AMAX1(Q2K(KFLIP),EPSQ2L) |
|---|
| 412 | TKE(I,K,J)=0.5*Q2K(KFLIP) |
|---|
| 413 | IF(KFLIP/=KTE)EL_MYJ(I,K,J)=EL(KFLIP) ! EL IS NOT DEFINED AT KTE |
|---|
| 414 | ENDDO |
|---|
| 415 | ! |
|---|
| 416 | ENDDO |
|---|
| 417 | ! |
|---|
| 418 | !---------------------------------------------------------------------- |
|---|
| 419 | ENDDO setup_integration |
|---|
| 420 | !---------------------------------------------------------------------- |
|---|
| 421 | ! |
|---|
| 422 | !*** CONVERT SURFACE SENSIBLE TEMPERATURE TO POTENTIAL TEMPERATURE. |
|---|
| 423 | ! |
|---|
| 424 | DO J=JTS,JTE |
|---|
| 425 | DO I=ITS,ITE |
|---|
| 426 | PSFC=PINT(I,LOWLYR(I,J),J) |
|---|
| 427 | THSK(I,J)=TSK(I,J)*(1.E5/PSFC)**CAPA |
|---|
| 428 | ENDDO |
|---|
| 429 | ENDDO |
|---|
| 430 | ! |
|---|
| 431 | !---------------------------------------------------------------------- |
|---|
| 432 | ! |
|---|
| 433 | !---------------------------------------------------------------------- |
|---|
| 434 | main_integration: DO J=JTS,JTE |
|---|
| 435 | !---------------------------------------------------------------------- |
|---|
| 436 | ! |
|---|
| 437 | DO I=ITS,ITE |
|---|
| 438 | ! |
|---|
| 439 | !*** FILL 1-D VERTICAL ARRAYS |
|---|
| 440 | !*** AND FLIP DIRECTION SINCE MYJ SCHEME |
|---|
| 441 | !*** COUNTS DOWNWARD FROM THE DOMAIN'S TOP |
|---|
| 442 | ! |
|---|
| 443 | DO K=KTE,KTS,-1 |
|---|
| 444 | KFLIP=KTE+1-K |
|---|
| 445 | THEK(K)=THE(I,KFLIP,J) |
|---|
| 446 | RATIOMX=QV(I,KFLIP,J) |
|---|
| 447 | QK(K)=RATIOMX/(1.+RATIOMX) |
|---|
| 448 | CWMK(K)=CWM(I,KFLIP,J) |
|---|
| 449 | ZHK(K)=ZINT(I,K,J) |
|---|
| 450 | RHOK(K,I)=PMID(I,KFLIP,J)/(R_D*T(I,KFLIP,J)* & |
|---|
| 451 | & (1.+P608*QK(K)-CWMK(K))) |
|---|
| 452 | ENDDO |
|---|
| 453 | ! |
|---|
| 454 | !*** COUNTING DOWNWARD FROM THE TOP, THE EXCHANGE COEFFICIENTS AKH |
|---|
| 455 | !*** ARE DEFINED ON THE BOTTOMS OF THE LAYERS KTS TO KTE-1. THESE COEFFICIENTS |
|---|
| 456 | !*** ARE ALSO MULTIPLIED BY THE DENSITY AT THE BOTTOM INTERFACE LEVEL. |
|---|
| 457 | ! |
|---|
| 458 | DO K=KTS,KTE-1 |
|---|
| 459 | AKHK(K)=AKH(I,K,J)*0.5*(RHOK(K,I)+RHOK(K+1,I)) |
|---|
| 460 | ENDDO |
|---|
| 461 | ! |
|---|
| 462 | ZHK(KTE+1)=ZINT(I,KTE+1,J) |
|---|
| 463 | ! |
|---|
| 464 | SEAMASK=XLAND(I,J)-1. |
|---|
| 465 | THZ0(I,J)=(1.-SEAMASK)*THSK(I,J)+SEAMASK*THZ0(I,J) |
|---|
| 466 | ! |
|---|
| 467 | LLOW=LOWLYR(I,J) |
|---|
| 468 | AKHS_DENS=AKHS(I,J)*RHOK(KTE+1-LLOW,I) |
|---|
| 469 | ! |
|---|
| 470 | IF(SEAMASK<0.5)THEN |
|---|
| 471 | QFC1=XLV*CHKLOWQ(I,J)*AKHS_DENS |
|---|
| 472 | ! |
|---|
| 473 | IF(SNOW(I,J)>0..OR.SICE(I,J)>0.5)THEN |
|---|
| 474 | QFC1=QFC1*RLIVWV |
|---|
| 475 | ENDIF |
|---|
| 476 | ! |
|---|
| 477 | IF(QFC1>0.)THEN |
|---|
| 478 | QLOW=QK(KTE+1-LLOW) |
|---|
| 479 | QSFC(I,J)=QLOW+ELFLX(I,J)/QFC1 |
|---|
| 480 | ENDIF |
|---|
| 481 | ! |
|---|
| 482 | ELSE |
|---|
| 483 | PSFC=PINT(I,LOWLYR(I,J),J) |
|---|
| 484 | EXNSFC=(1.E5/PSFC)**CAPA |
|---|
| 485 | QSFC(I,J)=PQ0SEA/PSFC & |
|---|
| 486 | & *EXP(A2*(THSK(I,J)-A3*EXNSFC)/(THSK(I,J)-A4*EXNSFC)) |
|---|
| 487 | ENDIF |
|---|
| 488 | ! |
|---|
| 489 | QZ0 (I,J)=(1.-SEAMASK)*QSFC(I,J)+SEAMASK*QZ0 (I,J) |
|---|
| 490 | ! |
|---|
| 491 | !*** LOWEST LAYER ABOVE GROUND MUST BE FLIPPED |
|---|
| 492 | ! |
|---|
| 493 | LMH=KTE-LOWLYR(I,J)+1 |
|---|
| 494 | ! |
|---|
| 495 | !---------------------------------------------------------------------- |
|---|
| 496 | !*** CARRY OUT THE VERTICAL DIFFUSION OF |
|---|
| 497 | !*** TEMPERATURE AND WATER VAPOR |
|---|
| 498 | !---------------------------------------------------------------------- |
|---|
| 499 | ! |
|---|
| 500 | CALL VDIFH(DTDIF,LMH,THZ0(I,J),QZ0(I,J) & |
|---|
| 501 | & ,AKHS_DENS,CHKLOWQ(I,J),CT(I,J) & |
|---|
| 502 | & ,THEK,QK,CWMK,AKHK,ZHK,RHOK(KTS,I) & |
|---|
| 503 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 504 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 505 | & ,ITS,ITE,JTS,JTE,KTS,KTE,I,J) |
|---|
| 506 | !---------------------------------------------------------------------- |
|---|
| 507 | !*** |
|---|
| 508 | !*** COMPUTE PRIMARY VARIABLE TENDENCIES |
|---|
| 509 | !*** |
|---|
| 510 | DO K=KTS,KTE |
|---|
| 511 | KFLIP=KTE+1-K |
|---|
| 512 | THOLD=TH(I,K,J) |
|---|
| 513 | THNEW=THEK(KFLIP)+CWMK(KFLIP)*ELOCP*APE(I,K,J) |
|---|
| 514 | DTDT=(THNEW-THOLD)*RDTTURBL |
|---|
| 515 | QOLD=QV(I,K,J)/(1.+QV(I,K,J)) |
|---|
| 516 | DQDT=(QK(KFLIP)-QOLD)*RDTTURBL |
|---|
| 517 | DCDT=(CWMK(KFLIP)-CWM(I,K,J))*RDTTURBL |
|---|
| 518 | ! |
|---|
| 519 | RTHBLTEN(I,K,J)=DTDT |
|---|
| 520 | RQVBLTEN(I,K,J)=DQDT/(1.-QK(KFLIP))**2 |
|---|
| 521 | RQCBLTEN(I,K,J)=DCDT |
|---|
| 522 | ENDDO |
|---|
| 523 | ! |
|---|
| 524 | !*** Begin debugging |
|---|
| 525 | ! IF(I==IMD.AND.J==JMD)THEN |
|---|
| 526 | ! PRINT_DIAG=0 |
|---|
| 527 | ! ELSE |
|---|
| 528 | ! PRINT_DIAG=0 |
|---|
| 529 | ! ENDIF |
|---|
| 530 | ! IF(I==227.AND.J==363)PRINT_DIAG=0 |
|---|
| 531 | !*** End debugging |
|---|
| 532 | ! |
|---|
| 533 | PSFC=.01*PINT(I,LOWLYR(I,J),J) |
|---|
| 534 | ZSL_DIAG=0.5*DZ(I,1,J) |
|---|
| 535 | ! |
|---|
| 536 | !*** Begin debugging |
|---|
| 537 | ! IF(PRINT_DIAG==1)THEN |
|---|
| 538 | ! |
|---|
| 539 | ! write(6,"(a, 2i5, 2i3, 2f8.2, f6.2, 2f8.2)") & |
|---|
| 540 | ! '{turb4 i,j, Kpbl, Kmxl, Psfc, Zsfc, Zsl, Zpbl, Zmxl = ' & |
|---|
| 541 | ! , i, j, KPBL(i,j), KTE-LMXL+1, PSFC, ZHK(LMH+1), ZSL_diag & |
|---|
| 542 | ! , PBLH(i,j), ZHK(LMXL)-ZHK(LMH+1) |
|---|
| 543 | ! write(6,"(a, 2f7.2, f7.3, 3e11.4)") & |
|---|
| 544 | ! '{turb4 tsk, thsk, qz0, q**2_0, akhs, exch_0 = ' & |
|---|
| 545 | ! , tsk(i,j)-273.15, thsk(i,j), 1000.*qz0(i,j) & |
|---|
| 546 | ! , 2.*tke_myj(i,1,j), akhs(i,j), akhs(i,j)*ZSL_diag |
|---|
| 547 | ! write(6,"(a)") & |
|---|
| 548 | ! '{turb5 k, Pmid, Pint_1, Tc, TH, DTH, GH, S2, EL, Q**2, Akh, EXCH_h, Dz, Dp' |
|---|
| 549 | ! do k=kts,kte/2 |
|---|
| 550 | ! KFLIP=KTE-K !-- Includes the KFLIP-1 in earlier versions |
|---|
| 551 | ! write(6,"(a,i3, 2f8.2, 2f8.3, 3e12.4, 4e11.4, f7.2, f6.2)") & |
|---|
| 552 | ! '{turb5 ', k, .01*pmid(i,k,j),.01*pint(i,k,j), T(i,k,j)-273.15 & |
|---|
| 553 | ! , th(i,k,j), DTTURBL*rthblten(i,k,j), GH(KFLIP), S2(KFLIP) & |
|---|
| 554 | ! , el_myj(i,KFLIP,j), 2.*tke_myj(i,k+1,j), akh(i,KFLIP,j) & |
|---|
| 555 | ! , exch_h(i,k,j), dz(i,k,j), .01*(pint(i,k,j)-pint(i,k+1,j)) |
|---|
| 556 | ! enddo |
|---|
| 557 | ! |
|---|
| 558 | ! ELSEIF(PRINT_DIAG==2)THEN |
|---|
| 559 | ! |
|---|
| 560 | ! write(6,"(a, 2i5, 2i3, 2f8.2, f6.2, 2f8.2)") & |
|---|
| 561 | ! '}turb4 i,j, Kpbl, Kmxl, Psfc, Zsfc, Zsl, Zpbl, Zmxl = ' & |
|---|
| 562 | ! , i, j, KPBL(i,j), KTE-LMXL+1, PSFC, ZHK(LMH+1), ZSL_diag & |
|---|
| 563 | ! , PBLH(i,j), ZHK(LMXL)-ZHK(LMH+1) |
|---|
| 564 | ! write(6,"(a, 2f7.2, f7.3, 3e11.4)") & |
|---|
| 565 | ! '}turb4 tsk, thsk, qz0, q**2_0, akhs, exch_0 = ' & |
|---|
| 566 | ! , tsk(i,j)-273.15, thsk(i,j), 1000.*qz0(i,j) & |
|---|
| 567 | ! , 2.*tke_myj(i,1,j), akhs(i,j), akhs(i,j)*ZSL_diag |
|---|
| 568 | ! write(6,"(a)") & |
|---|
| 569 | ! '}turb5 k, Pmid, Pint_1, Tc, TH, DTH, GH, S2, EL, Q**2, Akh, EXCH_h, Dz, Dp' |
|---|
| 570 | ! do k=kts,kte/2 |
|---|
| 571 | ! KFLIP=KTE-K !-- Includes the KFLIP-1 in earlier versions |
|---|
| 572 | ! write(6,"(a,i3, 2f8.2, 2f8.3, 3e12.4, 4e11.4, f7.2, f6.2)") & |
|---|
| 573 | ! '}turb5 ', k, .01*pmid(i,k,j),.01*pint(i,k,j), T(i,k,j)-273.15 & |
|---|
| 574 | ! , th(i,k,j), DTTURBL*rthblten(i,k,j), GH(KFLIP), S2(KFLIP) & |
|---|
| 575 | ! , el_myj(i,KFLIP,j), 2.*tke_myj(i,k+1,j), akh(i,KFLIP,j) & |
|---|
| 576 | ! , exch_h(i,k,j), dz(i,k,j), .01*(pint(i,k,j)-pint(i,k+1,j)) |
|---|
| 577 | ! enddo |
|---|
| 578 | ! ENDIF |
|---|
| 579 | !*** End debugging |
|---|
| 580 | ! |
|---|
| 581 | !---------------------------------------------------------------------- |
|---|
| 582 | ENDDO |
|---|
| 583 | !---------------------------------------------------------------------- |
|---|
| 584 | DO I=ITS,ITE |
|---|
| 585 | ! |
|---|
| 586 | !*** FILL 1-D VERTICAL ARRAYS |
|---|
| 587 | !*** AND FLIP DIRECTION SINCE MYJ SCHEME |
|---|
| 588 | !*** COUNTS DOWNWARD FROM THE DOMAIN'S TOP |
|---|
| 589 | ! |
|---|
| 590 | DO K=KTS,KTE-1 |
|---|
| 591 | AKMK(K)=AKM(I,K,J) |
|---|
| 592 | AKMK(K)=AKMK(K)*(RHOK(K,I)+RHOK(K+1,I))*0.5 |
|---|
| 593 | ENDDO |
|---|
| 594 | ! |
|---|
| 595 | LLOW=LOWLYR(I,J) |
|---|
| 596 | AKMS_DENS=AKMS(I,J)*RHOK(KTE+1-LLOW,I) |
|---|
| 597 | ! |
|---|
| 598 | DO K=KTE,KTS,-1 |
|---|
| 599 | KFLIP=KTE+1-K |
|---|
| 600 | UK(K)=U(I,KFLIP,J) |
|---|
| 601 | VK(K)=V(I,KFLIP,J) |
|---|
| 602 | ZHK(K)=ZINT(I,K,J) |
|---|
| 603 | ENDDO |
|---|
| 604 | ZHK(KTE+1)=ZINT(I,KTE+1,J) |
|---|
| 605 | ! |
|---|
| 606 | !---------------------------------------------------------------------- |
|---|
| 607 | !*** CARRY OUT THE VERTICAL DIFFUSION OF |
|---|
| 608 | !*** VELOCITY COMPONENTS |
|---|
| 609 | !---------------------------------------------------------------------- |
|---|
| 610 | ! |
|---|
| 611 | CALL VDIFV(LMH,DTDIF,UZ0(I,J),VZ0(I,J) & |
|---|
| 612 | & ,AKMS_DENS,UK,VK,AKMK,ZHK,RHOK(KTS,I) & |
|---|
| 613 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 614 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 615 | & ,ITS,ITE,JTS,JTE,KTS,KTE,I,J) |
|---|
| 616 | ! |
|---|
| 617 | !---------------------------------------------------------------------- |
|---|
| 618 | !*** |
|---|
| 619 | !*** COMPUTE PRIMARY VARIABLE TENDENCIES |
|---|
| 620 | !*** |
|---|
| 621 | DO K=KTS,KTE |
|---|
| 622 | KFLIP=KTE+1-K |
|---|
| 623 | DUDT=(UK(KFLIP)-U(I,K,J))*RDTTURBL |
|---|
| 624 | DVDT=(VK(KFLIP)-V(I,K,J))*RDTTURBL |
|---|
| 625 | RUBLTEN(I,K,J)=DUDT |
|---|
| 626 | RVBLTEN(I,K,J)=DVDT |
|---|
| 627 | ENDDO |
|---|
| 628 | ! |
|---|
| 629 | ENDDO |
|---|
| 630 | !---------------------------------------------------------------------- |
|---|
| 631 | ! |
|---|
| 632 | ENDDO main_integration |
|---|
| 633 | ! |
|---|
| 634 | !---------------------------------------------------------------------- |
|---|
| 635 | ! |
|---|
| 636 | END SUBROUTINE QNSEPBL |
|---|
| 637 | ! |
|---|
| 638 | !---------------------------------------------------------------------- |
|---|
| 639 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 640 | !---------------------------------------------------------------------- |
|---|
| 641 | SUBROUTINE MIXLEN & |
|---|
| 642 | !---------------------------------------------------------------------- |
|---|
| 643 | ! ****************************************************************** |
|---|
| 644 | ! * * |
|---|
| 645 | ! * LEVEL 2.5 MIXING LENGTH * |
|---|
| 646 | ! * * |
|---|
| 647 | ! ****************************************************************** |
|---|
| 648 | ! |
|---|
| 649 | &(LMH,U,V,T,THE,Q,CWM,Q2,Z,USTAR,CORF & |
|---|
| 650 | &,S2,GH,RI,EL,PBLH,LPBL,LMXL,CT & |
|---|
| 651 | &,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 652 | &,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 653 | &,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 654 | !---------------------------------------------------------------------- |
|---|
| 655 | ! |
|---|
| 656 | IMPLICIT NONE |
|---|
| 657 | ! |
|---|
| 658 | !---------------------------------------------------------------------- |
|---|
| 659 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 660 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 661 | & ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 662 | ! |
|---|
| 663 | INTEGER,INTENT(IN) :: LMH |
|---|
| 664 | ! |
|---|
| 665 | INTEGER,INTENT(OUT) :: LMXL,LPBL |
|---|
| 666 | ! |
|---|
| 667 | REAL,DIMENSION(KTS:KTE),INTENT(IN) :: CWM,Q,Q2,T,THE,U,V |
|---|
| 668 | ! |
|---|
| 669 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 670 | ! |
|---|
| 671 | REAL,INTENT(OUT) :: PBLH |
|---|
| 672 | ! |
|---|
| 673 | REAL,DIMENSION(KTS:KTE-1),INTENT(OUT) :: EL,RI,GH,S2 |
|---|
| 674 | ! |
|---|
| 675 | REAL,INTENT(INOUT) :: CT |
|---|
| 676 | ! |
|---|
| 677 | REAL,INTENT(IN) :: CORF,USTAR |
|---|
| 678 | !---------------------------------------------------------------------- |
|---|
| 679 | !*** |
|---|
| 680 | !*** LOCAL VARIABLES |
|---|
| 681 | !*** |
|---|
| 682 | INTEGER :: K,LPBLM |
|---|
| 683 | ! |
|---|
| 684 | REAL :: A,ADEN,B,BDEN,AUBR,BUBR,BLMX,EL0,ELOQ2X,GHL,S2L & |
|---|
| 685 | & ,QOL2ST,QOL2UN,QDZL,RDZ,SQ,SREL,SZQ,TEM,THM,VKRMZ,RLAMBDA & |
|---|
| 686 | & ,RLB,RLN,F |
|---|
| 687 | ! |
|---|
| 688 | REAL,DIMENSION(KTS:KTE) :: Q1,EN2 |
|---|
| 689 | ! |
|---|
| 690 | REAL,DIMENSION(KTS:KTE-1) :: DTH,ELM,REL |
|---|
| 691 | ! |
|---|
| 692 | !---------------------------------------------------------------------- |
|---|
| 693 | !********************************************************************** |
|---|
| 694 | !--------------FIND THE HEIGHT OF THE PBL------------------------------- |
|---|
| 695 | LPBL=LMH |
|---|
| 696 | ! |
|---|
| 697 | DO K=LMH-1,1,-1 |
|---|
| 698 | IF(Q2(K)<=EPSQ2L*FH)THEN |
|---|
| 699 | LPBL=K |
|---|
| 700 | GO TO 110 |
|---|
| 701 | ENDIF |
|---|
| 702 | ENDDO |
|---|
| 703 | ! |
|---|
| 704 | LPBL=1 |
|---|
| 705 | ! |
|---|
| 706 | !--------------THE HEIGHT OF THE PBL------------------------------------ |
|---|
| 707 | ! |
|---|
| 708 | 110 PBLH=Z(LPBL)-Z(LMH+1) |
|---|
| 709 | ! |
|---|
| 710 | !----------------------------------------------------------------------- |
|---|
| 711 | DO K=KTS,LMH |
|---|
| 712 | Q1(K)=0. |
|---|
| 713 | ENDDO |
|---|
| 714 | ! |
|---|
| 715 | DO K=1,LMH-1 |
|---|
| 716 | DTH(K)=THE(K)-THE(K+1) |
|---|
| 717 | ENDDO |
|---|
| 718 | ! |
|---|
| 719 | DO K=LMH-2,1,-1 |
|---|
| 720 | IF(DTH(K)>0..AND.DTH(K+1)<=0.)THEN |
|---|
| 721 | DTH(K)=DTH(K)+CT |
|---|
| 722 | EXIT |
|---|
| 723 | ENDIF |
|---|
| 724 | ENDDO |
|---|
| 725 | ! |
|---|
| 726 | CT=0. |
|---|
| 727 | !---------------------------------------------------------------------- |
|---|
| 728 | !*** COMPUTE LOCAL GRADIENT RICHARDSON NUMBER |
|---|
| 729 | !---------------------------------------------------------------------- |
|---|
| 730 | DO K=KTS,LMH-1 |
|---|
| 731 | RDZ=2./(Z(K)-Z(K+2)) |
|---|
| 732 | S2L=((U(K)-U(K+1))**2+(V(K)-V(K+1))**2)*RDZ*RDZ ! S**2 |
|---|
| 733 | S2L=MAX(S2L,EPSGM) |
|---|
| 734 | S2(K)=S2L |
|---|
| 735 | ! |
|---|
| 736 | TEM=(T(K)+T(K+1))*0.5 |
|---|
| 737 | THM=(THE(K)+THE(K+1))*0.5 |
|---|
| 738 | ! |
|---|
| 739 | A=THM*P608 |
|---|
| 740 | B=(ELOCP/TEM-1.-P608)*THM |
|---|
| 741 | ! |
|---|
| 742 | GHL=(DTH(K)*((Q(K)+Q(K+1)+CWM(K)+CWM(K+1))*(0.5*P608)+1.) & |
|---|
| 743 | & +(Q(K)-Q(K+1)+CWM(K)-CWM(K+1))*A & |
|---|
| 744 | & +(CWM(K)-CWM(K+1))*B)*RDZ ! dTheta/dz |
|---|
| 745 | ! |
|---|
| 746 | IF(ABS(GHL)<=EPSGH)GHL=EPSGH |
|---|
| 747 | ! |
|---|
| 748 | EN2(K)=GHL*G/THM ! N**2 |
|---|
| 749 | ! |
|---|
| 750 | GH(K)=GHL |
|---|
| 751 | RI(K)=EN2(K)/S2L |
|---|
| 752 | ENDDO |
|---|
| 753 | ! |
|---|
| 754 | !---------------------------------------------------------------------- |
|---|
| 755 | !*** FIND MAXIMUM MIXING LENGTHS AND THE LEVEL OF THE PBL TOP |
|---|
| 756 | !---------------------------------------------------------------------- |
|---|
| 757 | ! |
|---|
| 758 | LMXL=LMH |
|---|
| 759 | ! |
|---|
| 760 | DO K=KTS,LMH-1 |
|---|
| 761 | S2L=S2(K) |
|---|
| 762 | GHL=GH(K) |
|---|
| 763 | ! |
|---|
| 764 | IF(GHL>=EPSGH)THEN |
|---|
| 765 | IF(S2L/GHL<=REQU)THEN |
|---|
| 766 | ELM(K)=EPSL |
|---|
| 767 | LMXL=K |
|---|
| 768 | ELSE |
|---|
| 769 | AUBR=(AUBM*S2L+AUBH*GHL)*GHL |
|---|
| 770 | BUBR= BUBM*S2L+BUBH*GHL |
|---|
| 771 | QOL2ST=(-0.5*BUBR+SQRT(BUBR*BUBR*0.25-AUBR*CUBR))*RCUBR |
|---|
| 772 | ELOQ2X=1./QOL2ST |
|---|
| 773 | ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL) |
|---|
| 774 | ENDIF |
|---|
| 775 | ELSE |
|---|
| 776 | ADEN=(ADNM*S2L+ADNH*GHL)*GHL |
|---|
| 777 | BDEN= BDNM*S2L+BDNH*GHL |
|---|
| 778 | QOL2UN=-0.5*BDEN+SQRT(BDEN*BDEN*0.25-ADEN) |
|---|
| 779 | ELOQ2X=1./(QOL2UN+EPSRU) ! repsr1/qol2un |
|---|
| 780 | ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL) |
|---|
| 781 | ENDIF |
|---|
| 782 | ENDDO |
|---|
| 783 | ! |
|---|
| 784 | IF(ELM(LMH-1)==EPSL)LMXL=LMH |
|---|
| 785 | ! |
|---|
| 786 | !---------------------------------------------------------------------- |
|---|
| 787 | !*** THE HEIGHT OF THE MIXED LAYER |
|---|
| 788 | !---------------------------------------------------------------------- |
|---|
| 789 | ! |
|---|
| 790 | BLMX=Z(LMXL)-Z(LMH+1) |
|---|
| 791 | ! |
|---|
| 792 | !---------------------------------------------------------------------- |
|---|
| 793 | DO K=LPBL,LMH |
|---|
| 794 | Q1(K)=SQRT(Q2(K)) |
|---|
| 795 | ENDDO |
|---|
| 796 | !---------------------------------------------------------------------- |
|---|
| 797 | SZQ=0. |
|---|
| 798 | SQ =0. |
|---|
| 799 | ! |
|---|
| 800 | DO K=KTS,LMH-1 |
|---|
| 801 | QDZL=(Q1(K)+Q1(K+1))*(Z(K+1)-Z(K+2)) |
|---|
| 802 | SZQ=(Z(K+1)+Z(K+2)-Z(LMH+1)-Z(LMH+1))*QDZL+SZQ |
|---|
| 803 | SQ=QDZL+SQ |
|---|
| 804 | ENDDO |
|---|
| 805 | ! |
|---|
| 806 | !---------------------------------------------------------------------- |
|---|
| 807 | !*** COMPUTATION OF ASYMPTOTIC L IN BLACKADAR FORMULA |
|---|
| 808 | !---------------------------------------------------------------------- |
|---|
| 809 | ! |
|---|
| 810 | EL0=MIN(ALPH*SZQ*0.5/SQ,EL0MAX) |
|---|
| 811 | EL0=MAX(EL0 ,EL0MIN) |
|---|
| 812 | ! |
|---|
| 813 | !---------------------------------------------------------------------- |
|---|
| 814 | !*** ABOVE THE PBL TOP |
|---|
| 815 | !---------------------------------------------------------------------- |
|---|
| 816 | ! |
|---|
| 817 | LPBLM=MAX(LPBL-1,1) |
|---|
| 818 | ! |
|---|
| 819 | DO K=KTS,LPBLM |
|---|
| 820 | EL(K)=MIN((Z(K)-Z(K+2))*ELFC,ELM(K)) |
|---|
| 821 | REL(K)=EL(K)/ELM(K) |
|---|
| 822 | ENDDO |
|---|
| 823 | ! |
|---|
| 824 | !---------------------------------------------------------------------- |
|---|
| 825 | !*** INSIDE THE PBL |
|---|
| 826 | !---------------------------------------------------------------------- |
|---|
| 827 | ! |
|---|
| 828 | IF(LPBL<LMH)THEN |
|---|
| 829 | DO K=LPBL,LMH-1 |
|---|
| 830 | VKRMZ=(Z(K+1)-Z(LMH+1))*VKARMAN |
|---|
| 831 | EL(K)=MIN(VKRMZ/(VKRMZ/EL0+1.),ELM(K)) |
|---|
| 832 | REL(K)=EL(K)/ELM(K) |
|---|
| 833 | ENDDO |
|---|
| 834 | ENDIF |
|---|
| 835 | ! |
|---|
| 836 | DO K=LPBL+1,LMH-2 |
|---|
| 837 | SREL=MIN(((REL(K-1)+REL(K+1))*0.5+REL(K))*0.5,REL(K)) |
|---|
| 838 | EL(K)=MAX(SREL*ELM(K),EPSL) |
|---|
| 839 | ENDDO |
|---|
| 840 | ! |
|---|
| 841 | !---------------------------------------------------------------------- |
|---|
| 842 | !*** MIXING LENGTH FOR THE QNSE MODEL IN STABLE CASE |
|---|
| 843 | !---------------------------------------------------------------------- |
|---|
| 844 | ! |
|---|
| 845 | F=MAX(CORF,EPS1) |
|---|
| 846 | RLAMBDA=F/(BLCKDR*USTAR) |
|---|
| 847 | DO K=KTS,LMH-1 |
|---|
| 848 | IF(EN2(K)>=0.0)THEN ! Stable case |
|---|
| 849 | VKRMZ=(Z(K+1)-Z(LMH+1))*VKARMAN |
|---|
| 850 | RLB=RLAMBDA+1./VKRMZ |
|---|
| 851 | RLN=SQRT(2.*EN2(K)/Q2(K))/CN |
|---|
| 852 | ! EL(K)=MIN(1./(RLB+RLN),ELM(K)) |
|---|
| 853 | EL(K)=1./(RLB+RLN) |
|---|
| 854 | ENDIF |
|---|
| 855 | ENDDO |
|---|
| 856 | ! |
|---|
| 857 | !---------------------------------------------------------------------- |
|---|
| 858 | END SUBROUTINE MIXLEN |
|---|
| 859 | !---------------------------------------------------------------------- |
|---|
| 860 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 861 | !---------------------------------------------------------------------- |
|---|
| 862 | SUBROUTINE PRODQ2 & |
|---|
| 863 | !---------------------------------------------------------------------- |
|---|
| 864 | ! ****************************************************************** |
|---|
| 865 | ! * * |
|---|
| 866 | ! * LEVEL 2.5 Q2 PRODUCTION/DISSIPATION * |
|---|
| 867 | ! * * |
|---|
| 868 | ! ****************************************************************** |
|---|
| 869 | ! |
|---|
| 870 | &(LMH,DTTURBL,USTAR,S2,RI,Q2,EL,Z,AKM,AKH & |
|---|
| 871 | &,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 872 | &,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 873 | &,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 874 | !---------------------------------------------------------------------- |
|---|
| 875 | ! |
|---|
| 876 | IMPLICIT NONE |
|---|
| 877 | ! |
|---|
| 878 | !---------------------------------------------------------------------- |
|---|
| 879 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 880 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 881 | & ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 882 | ! |
|---|
| 883 | INTEGER,INTENT(IN) :: LMH |
|---|
| 884 | ! |
|---|
| 885 | REAL,INTENT(IN) :: DTTURBL,USTAR |
|---|
| 886 | ! |
|---|
| 887 | REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: S2,RI,AKM,AKH,EL |
|---|
| 888 | ! |
|---|
| 889 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 890 | ! |
|---|
| 891 | REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: Q2 |
|---|
| 892 | !---------------------------------------------------------------------- |
|---|
| 893 | !*** |
|---|
| 894 | !*** LOCAL VARIABLES |
|---|
| 895 | !*** |
|---|
| 896 | INTEGER :: K |
|---|
| 897 | ! |
|---|
| 898 | REAL :: S2L,Q2L,DELTAZ,AKML,AKHL,EN2,PR,BPR,DIS,RC02 |
|---|
| 899 | ! |
|---|
| 900 | !---------------------------------------------------------------------- |
|---|
| 901 | !********************************************************************** |
|---|
| 902 | !---------------------------------------------------------------------- |
|---|
| 903 | ! |
|---|
| 904 | RC02=2.0/(C0*C0) |
|---|
| 905 | main_integration: DO K=1,LMH-1 |
|---|
| 906 | S2L=S2(K) |
|---|
| 907 | Q2L=Q2(K) |
|---|
| 908 | DELTAZ=0.5*(Z(K)-Z(K+2)) |
|---|
| 909 | AKML=AKM(K)*DELTAZ |
|---|
| 910 | AKHL=AKH(K)*DELTAZ |
|---|
| 911 | EN2=RI(K)*S2L !N**2 |
|---|
| 912 | ! |
|---|
| 913 | !*** TURBULENCE PRODUCTION TERM |
|---|
| 914 | ! |
|---|
| 915 | PR=AKML*S2L |
|---|
| 916 | ! |
|---|
| 917 | !*** BUOYANCY PRODUCTION |
|---|
| 918 | ! |
|---|
| 919 | BPR=AKHL*EN2 |
|---|
| 920 | ! |
|---|
| 921 | !*** DISSIPATION |
|---|
| 922 | ! |
|---|
| 923 | DIS=CEPS*(0.5*Q2L)**1.5/EL(K) |
|---|
| 924 | ! |
|---|
| 925 | Q2L=Q2L+2.0*(PR-BPR-DIS)*DTTURBL |
|---|
| 926 | Q2(K)=AMAX1(Q2L,EPSQ2L) |
|---|
| 927 | !---------------------------------------------------------------------- |
|---|
| 928 | !*** END OF PRODUCTION/DISSIPATION LOOP |
|---|
| 929 | !---------------------------------------------------------------------- |
|---|
| 930 | ! |
|---|
| 931 | ENDDO main_integration |
|---|
| 932 | ! |
|---|
| 933 | !---------------------------------------------------------------------- |
|---|
| 934 | !*** LOWER BOUNDARY CONDITION FOR Q2 |
|---|
| 935 | !---------------------------------------------------------------------- |
|---|
| 936 | ! |
|---|
| 937 | Q2(LMH)=AMAX1(RC02*USTAR*USTAR,EPSQ2L) |
|---|
| 938 | !---------------------------------------------------------------------- |
|---|
| 939 | ! |
|---|
| 940 | END SUBROUTINE PRODQ2 |
|---|
| 941 | ! |
|---|
| 942 | !---------------------------------------------------------------------- |
|---|
| 943 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 944 | !---------------------------------------------------------------------- |
|---|
| 945 | SUBROUTINE DIFCOF & |
|---|
| 946 | ! ****************************************************************** |
|---|
| 947 | ! * * |
|---|
| 948 | ! * DIFFUSION COEFFICIENTS KM, KH BASED ON THE QNSE THEORY * |
|---|
| 949 | ! * * |
|---|
| 950 | ! ****************************************************************** |
|---|
| 951 | &(LMH,EL,RI,Q2,Z,AKM,AKH & |
|---|
| 952 | &,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 953 | &,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 954 | &,ITS,ITE,JTS,JTE,KTS,KTE,PRINT_DIAG) ! debug |
|---|
| 955 | !---------------------------------------------------------------------- |
|---|
| 956 | ! |
|---|
| 957 | IMPLICIT NONE |
|---|
| 958 | ! |
|---|
| 959 | !---------------------------------------------------------------------- |
|---|
| 960 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 961 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 962 | & ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 963 | ! |
|---|
| 964 | INTEGER,INTENT(IN) :: LMH |
|---|
| 965 | ! |
|---|
| 966 | REAL,DIMENSION(KTS:KTE),INTENT(IN) :: Q2 |
|---|
| 967 | REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: EL,RI |
|---|
| 968 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 969 | ! |
|---|
| 970 | REAL,DIMENSION(KTS:KTE-1),INTENT(OUT) :: AKH,AKM |
|---|
| 971 | !---------------------------------------------------------------------- |
|---|
| 972 | !*** |
|---|
| 973 | !*** LOCAL VARIABLES |
|---|
| 974 | !*** |
|---|
| 975 | INTEGER :: K |
|---|
| 976 | ! |
|---|
| 977 | REAL :: AK0,ALPHAM,ALPHAH,RIL,RIL2,ARIL,ARIL2,ARIL4,ELL,Q1L,RDZ & |
|---|
| 978 | & ,AK0DZ,AKMIN |
|---|
| 979 | ! |
|---|
| 980 | !*** Begin debugging |
|---|
| 981 | INTEGER,INTENT(IN) :: PRINT_DIAG |
|---|
| 982 | ! REAL :: D2Tmin |
|---|
| 983 | !*** End debugging |
|---|
| 984 | ! |
|---|
| 985 | !---------------------------------------------------------------------- |
|---|
| 986 | !********************************************************************** |
|---|
| 987 | !---------------------------------------------------------------------- |
|---|
| 988 | ! |
|---|
| 989 | DO K=1,LMH-1 |
|---|
| 990 | ELL=EL(K) |
|---|
| 991 | Q1L=SQRT(0.5*Q2(K)) !Note that Q1L is SQRT(TKE) |
|---|
| 992 | RIL=RI(K) |
|---|
| 993 | AK0=C0*ELL*Q1L !KM in neutral case |
|---|
| 994 | ! |
|---|
| 995 | !---------------------------------------------------------------------- |
|---|
| 996 | !*** STABILITY FUNCTIONS ALPHAM AND ALPHAH |
|---|
| 997 | !---------------------------------------------------------------------- |
|---|
| 998 | ! |
|---|
| 999 | !!! UNSTABLE CASE |
|---|
| 1000 | ! |
|---|
| 1001 | IF(RIL<=0) THEN |
|---|
| 1002 | ARIL=MIN(ABS(RIL),2.*ARIMIN) |
|---|
| 1003 | ARIL2=ARIL*ARIL |
|---|
| 1004 | ARIL4=ARIL2*ARIL2 |
|---|
| 1005 | ALPHAM=1.0+BM1*ARIL+BM2*ARIL2 |
|---|
| 1006 | ALPHAH=AH1+BH1*ARIL+BH2*ARIL2+BH3*ARIL4 |
|---|
| 1007 | ! |
|---|
| 1008 | !!! STABLE CASE |
|---|
| 1009 | ! |
|---|
| 1010 | ELSE |
|---|
| 1011 | RIL2=RIL*RIL |
|---|
| 1012 | ALPHAM=(1.0+AM1*RIL2)/(1.0+AM2*RIL+AM3*RIL2) |
|---|
| 1013 | ALPHAH=(AH1+AH2*RIL+AH3*RIL2)/(1.0+AH4*RIL+AH5*RIL2) |
|---|
| 1014 | ENDIF |
|---|
| 1015 | ! |
|---|
| 1016 | !----------------------------------------------------------------------- |
|---|
| 1017 | !*** END OF STABILITY FUNCTIONS COMPUTATIONS |
|---|
| 1018 | !----------------------------------------------------------------------- |
|---|
| 1019 | ! |
|---|
| 1020 | !---------------------------------------------------------------------- |
|---|
| 1021 | !*** DIFFUSION COEFFICIENTS |
|---|
| 1022 | !---------------------------------------------------------------------- |
|---|
| 1023 | ! |
|---|
| 1024 | RDZ=2./(Z(K)-Z(K+2)) |
|---|
| 1025 | AK0DZ=AK0*RDZ |
|---|
| 1026 | AKMIN=EPSKM*RDZ |
|---|
| 1027 | AKM(K)=MAX(AK0DZ*ALPHAM,AKMIN) |
|---|
| 1028 | AKH(K)=MAX(AK0DZ*ALPHAH,AKMIN) |
|---|
| 1029 | !---------------------------------------------------------------------- |
|---|
| 1030 | ENDDO |
|---|
| 1031 | !---------------------------------------------------------------------- |
|---|
| 1032 | ! |
|---|
| 1033 | END SUBROUTINE DIFCOF |
|---|
| 1034 | ! |
|---|
| 1035 | !---------------------------------------------------------------------- |
|---|
| 1036 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 1037 | !---------------------------------------------------------------------- |
|---|
| 1038 | SUBROUTINE VDIFQ & |
|---|
| 1039 | ! ****************************************************************** |
|---|
| 1040 | ! * * |
|---|
| 1041 | ! * VERTICAL DIFFUSION OF Q2 (TKE) * |
|---|
| 1042 | ! * * |
|---|
| 1043 | ! ****************************************************************** |
|---|
| 1044 | &(LMH,DTDIF,Q2,EL,Z & |
|---|
| 1045 | &,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1046 | &,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1047 | &,ITS,ITE,JTS,JTE,KTS,KTE) |
|---|
| 1048 | !---------------------------------------------------------------------- |
|---|
| 1049 | ! |
|---|
| 1050 | IMPLICIT NONE |
|---|
| 1051 | ! |
|---|
| 1052 | !---------------------------------------------------------------------- |
|---|
| 1053 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1054 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1055 | & ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 1056 | ! |
|---|
| 1057 | INTEGER,INTENT(IN) :: LMH |
|---|
| 1058 | ! |
|---|
| 1059 | REAL,INTENT(IN) :: DTDIF |
|---|
| 1060 | ! |
|---|
| 1061 | REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: EL |
|---|
| 1062 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 1063 | ! |
|---|
| 1064 | REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: Q2 |
|---|
| 1065 | !---------------------------------------------------------------------- |
|---|
| 1066 | !*** |
|---|
| 1067 | !*** LOCAL VARIABLES |
|---|
| 1068 | !*** |
|---|
| 1069 | INTEGER :: K |
|---|
| 1070 | ! |
|---|
| 1071 | REAL :: ADEN,AKQS,BDEN,BESH,BESM,CDEN,CF,DTOZS,ELL,ELOQ2,ELOQ4 & |
|---|
| 1072 | & ,ELQDZ,ESH,ESM,ESQHF,GHL,GML,Q1L,RDEN,RDZ |
|---|
| 1073 | ! |
|---|
| 1074 | REAL,DIMENSION(KTS:KTE-2) :: AKQ,CM,CR,DTOZ,RSQ2 |
|---|
| 1075 | !---------------------------------------------------------------------- |
|---|
| 1076 | !********************************************************************** |
|---|
| 1077 | !---------------------------------------------------------------------- |
|---|
| 1078 | !*** |
|---|
| 1079 | !*** VERTICAL TURBULENT DIFFUSION |
|---|
| 1080 | !*** |
|---|
| 1081 | !---------------------------------------------------------------------- |
|---|
| 1082 | ESQHF=0.5*ESQ |
|---|
| 1083 | ! |
|---|
| 1084 | DO K=KTS,LMH-2 |
|---|
| 1085 | DTOZ(K)=(DTDIF+DTDIF)/(Z(K)-Z(K+2)) |
|---|
| 1086 | AKQ(K)=SQRT((Q2(K)+Q2(K+1))*0.5)*(EL(K)+EL(K+1))*ESQHF & |
|---|
| 1087 | & /(Z(K+1)-Z(K+2)) |
|---|
| 1088 | CR(K)=-DTOZ(K)*AKQ(K) |
|---|
| 1089 | ENDDO |
|---|
| 1090 | ! |
|---|
| 1091 | CM(1)=DTOZ(1)*AKQ(1)+1. |
|---|
| 1092 | RSQ2(1)=Q2(1) |
|---|
| 1093 | ! |
|---|
| 1094 | DO K=KTS+1,LMH-2 |
|---|
| 1095 | CF=-DTOZ(K)*AKQ(K-1)/CM(K-1) |
|---|
| 1096 | CM(K)=-CR(K-1)*CF+(AKQ(K-1)+AKQ(K))*DTOZ(K)+1. |
|---|
| 1097 | RSQ2(K)=-RSQ2(K-1)*CF+Q2(K) |
|---|
| 1098 | ENDDO |
|---|
| 1099 | ! |
|---|
| 1100 | DTOZS=(DTDIF+DTDIF)/(Z(LMH-1)-Z(LMH+1)) |
|---|
| 1101 | AKQS=SQRT((Q2(LMH-1)+Q2(LMH))*0.5)*(EL(LMH-1)+ELZ0)*ESQHF & |
|---|
| 1102 | & /(Z(LMH)-Z(LMH+1)) |
|---|
| 1103 | ! |
|---|
| 1104 | CF=-DTOZS*AKQ(LMH-2)/CM(LMH-2) |
|---|
| 1105 | ! |
|---|
| 1106 | Q2(LMH-1)=(DTOZS*AKQS*Q2(LMH)-RSQ2(LMH-2)*CF+Q2(LMH-1)) & |
|---|
| 1107 | & /((AKQ(LMH-2)+AKQS)*DTOZS-CR(LMH-2)*CF+1.) |
|---|
| 1108 | ! |
|---|
| 1109 | DO K=LMH-2,KTS,-1 |
|---|
| 1110 | Q2(K)=(-CR(K)*Q2(K+1)+RSQ2(K))/CM(K) |
|---|
| 1111 | ENDDO |
|---|
| 1112 | !---------------------------------------------------------------------- |
|---|
| 1113 | ! |
|---|
| 1114 | END SUBROUTINE VDIFQ |
|---|
| 1115 | ! |
|---|
| 1116 | !---------------------------------------------------------------------- |
|---|
| 1117 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 1118 | !--------------------------------------------------------------------- |
|---|
| 1119 | SUBROUTINE VDIFH(DTDIF,LMH,THZ0,QZ0,RKHS,CHKLOWQ,CT & |
|---|
| 1120 | & ,THE,Q,CWM,RKH,Z,RHO & |
|---|
| 1121 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1122 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1123 | & ,ITS,ITE,JTS,JTE,KTS,KTE,I,J) |
|---|
| 1124 | ! *************************************************************** |
|---|
| 1125 | ! * * |
|---|
| 1126 | ! * VERTICAL DIFFUSION OF MASS VARIABLES * |
|---|
| 1127 | ! * * |
|---|
| 1128 | ! *************************************************************** |
|---|
| 1129 | !--------------------------------------------------------------------- |
|---|
| 1130 | ! |
|---|
| 1131 | IMPLICIT NONE |
|---|
| 1132 | ! |
|---|
| 1133 | !--------------------------------------------------------------------- |
|---|
| 1134 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1135 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1136 | & ,ITS,ITE,JTS,JTE,KTS,KTE,I,J |
|---|
| 1137 | ! |
|---|
| 1138 | INTEGER,INTENT(IN) :: LMH |
|---|
| 1139 | ! |
|---|
| 1140 | REAL,INTENT(IN) :: CHKLOWQ,CT,DTDIF,QZ0,RKHS,THZ0 |
|---|
| 1141 | ! |
|---|
| 1142 | REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: RKH |
|---|
| 1143 | REAL,DIMENSION(KTS:KTE),INTENT(IN) :: RHO |
|---|
| 1144 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 1145 | REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: CWM,Q,THE |
|---|
| 1146 | ! |
|---|
| 1147 | !---------------------------------------------------------------------- |
|---|
| 1148 | !*** |
|---|
| 1149 | !*** LOCAL VARIABLES |
|---|
| 1150 | !*** |
|---|
| 1151 | INTEGER :: K |
|---|
| 1152 | ! |
|---|
| 1153 | REAL :: CF,CMB,CMCB,CMQB,CMTB,CTHF,DTOZL,DTOZS & |
|---|
| 1154 | & ,RCML,RKHH,RKQS,RSCB,RSQB,RSTB |
|---|
| 1155 | ! |
|---|
| 1156 | REAL,DIMENSION(KTS:KTE-1) :: CM,CR,DTOZ,RKCT,RSC,RSQ,RST |
|---|
| 1157 | ! |
|---|
| 1158 | !---------------------------------------------------------------------- |
|---|
| 1159 | !********************************************************************** |
|---|
| 1160 | !---------------------------------------------------------------------- |
|---|
| 1161 | CTHF=0.5*CT |
|---|
| 1162 | ! |
|---|
| 1163 | DO K=KTS,LMH-1 |
|---|
| 1164 | DTOZ(K)=DTDIF/(Z(K)-Z(K+1)) |
|---|
| 1165 | CR(K)=-DTOZ(K)*RKH(K) |
|---|
| 1166 | RKCT(K)=RKH(K)*(Z(K)-Z(K+2))*CTHF |
|---|
| 1167 | ENDDO |
|---|
| 1168 | ! |
|---|
| 1169 | CM(KTS)=DTOZ(KTS)*RKH(KTS)+RHO(KTS) |
|---|
| 1170 | !---------------------------------------------------------------------- |
|---|
| 1171 | RST(KTS)=-RKCT(KTS)*DTOZ(KTS) & |
|---|
| 1172 | & +THE(KTS)*RHO(KTS) |
|---|
| 1173 | RSQ(KTS)=Q(KTS) *RHO(KTS) |
|---|
| 1174 | RSC(KTS)=CWM(KTS)*RHO(KTS) |
|---|
| 1175 | !---------------------------------------------------------------------- |
|---|
| 1176 | DO K=KTS+1,LMH-1 |
|---|
| 1177 | DTOZL=DTOZ(K) |
|---|
| 1178 | CF=-DTOZL*RKH(K-1)/CM(K-1) |
|---|
| 1179 | CM(K)=-CR(K-1)*CF+(RKH(K-1)+RKH(K))*DTOZL+RHO(K) |
|---|
| 1180 | RST(K)=-RST(K-1)*CF+(RKCT(K-1)-RKCT(K))*DTOZL+THE(K)*RHO(K) |
|---|
| 1181 | RSQ(K)=-RSQ(K-1)*CF+Q(K) *RHO(K) |
|---|
| 1182 | RSC(K)=-RSC(K-1)*CF+CWM(K)*RHO(K) |
|---|
| 1183 | ENDDO |
|---|
| 1184 | ! |
|---|
| 1185 | DTOZS=DTDIF/(Z(LMH)-Z(LMH+1)) |
|---|
| 1186 | RKHH=RKH(LMH-1) |
|---|
| 1187 | ! |
|---|
| 1188 | CF=-DTOZS*RKHH/CM(LMH-1) |
|---|
| 1189 | RKQS=RKHS*CHKLOWQ |
|---|
| 1190 | ! |
|---|
| 1191 | CMB=CR(LMH-1)*CF |
|---|
| 1192 | CMTB=-CMB+(RKHH+RKHS)*DTOZS+RHO(LMH) |
|---|
| 1193 | CMQB=-CMB+(RKHH+RKQS)*DTOZS+RHO(LMH) |
|---|
| 1194 | CMCB=-CMB+(RKHH )*DTOZS+RHO(LMH) |
|---|
| 1195 | ! |
|---|
| 1196 | RSTB=-RST(LMH-1)*CF+RKCT(LMH-1)*DTOZS+THE(LMH)*RHO(LMH) |
|---|
| 1197 | RSQB=-RSQ(LMH-1)*CF+Q(LMH) *RHO(LMH) |
|---|
| 1198 | RSCB=-RSC(LMH-1)*CF+CWM(LMH)*RHO(LMH) |
|---|
| 1199 | !---------------------------------------------------------------------- |
|---|
| 1200 | THE(LMH)=(DTOZS*RKHS*THZ0+RSTB)/CMTB |
|---|
| 1201 | Q(LMH) =(DTOZS*RKQS*QZ0 +RSQB)/CMQB |
|---|
| 1202 | CWM(LMH)=( RSCB)/CMCB |
|---|
| 1203 | !---------------------------------------------------------------------- |
|---|
| 1204 | DO K=LMH-1,KTS,-1 |
|---|
| 1205 | RCML=1./CM(K) |
|---|
| 1206 | THE(K)=(-CR(K)*THE(K+1)+RST(K))*RCML |
|---|
| 1207 | Q(K) =(-CR(K)* Q(K+1)+RSQ(K))*RCML |
|---|
| 1208 | CWM(K)=(-CR(K)*CWM(K+1)+RSC(K))*RCML |
|---|
| 1209 | ENDDO |
|---|
| 1210 | !---------------------------------------------------------------------- |
|---|
| 1211 | ! |
|---|
| 1212 | END SUBROUTINE VDIFH |
|---|
| 1213 | ! |
|---|
| 1214 | !--------------------------------------------------------------------- |
|---|
| 1215 | !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|---|
| 1216 | !--------------------------------------------------------------------- |
|---|
| 1217 | SUBROUTINE VDIFV(LMH,DTDIF,UZ0,VZ0,RKMS,U,V,RKM,Z,RHO & |
|---|
| 1218 | & ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1219 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1220 | ,ITS,ITE,JTS,JTE,KTS,KTE,I,J) |
|---|
| 1221 | ! *************************************************************** |
|---|
| 1222 | ! * * |
|---|
| 1223 | ! * VERTICAL DIFFUSION OF VELOCITY COMPONENTS * |
|---|
| 1224 | ! * * |
|---|
| 1225 | ! *************************************************************** |
|---|
| 1226 | !--------------------------------------------------------------------- |
|---|
| 1227 | ! |
|---|
| 1228 | IMPLICIT NONE |
|---|
| 1229 | ! |
|---|
| 1230 | !--------------------------------------------------------------------- |
|---|
| 1231 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 1232 | & ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 1233 | & ,ITS,ITE,JTS,JTE,KTS,KTE,I,J |
|---|
| 1234 | ! |
|---|
| 1235 | INTEGER,INTENT(IN) :: LMH |
|---|
| 1236 | ! |
|---|
| 1237 | REAL,INTENT(IN) :: RKMS,DTDIF,UZ0,VZ0 |
|---|
| 1238 | ! |
|---|
| 1239 | REAL,DIMENSION(KTS:KTE-1),INTENT(IN) :: RKM |
|---|
| 1240 | REAL,DIMENSION(KTS:KTE),INTENT(IN) :: RHO |
|---|
| 1241 | REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: Z |
|---|
| 1242 | ! |
|---|
| 1243 | REAL,DIMENSION(KTS:KTE),INTENT(INOUT) :: U,V |
|---|
| 1244 | !---------------------------------------------------------------------- |
|---|
| 1245 | !*** |
|---|
| 1246 | !*** LOCAL VARIABLES |
|---|
| 1247 | !*** |
|---|
| 1248 | INTEGER :: K |
|---|
| 1249 | ! |
|---|
| 1250 | REAL :: CF,DTOZAK,DTOZL,DTOZS,RCML,RCMVB,RHOK,RKMH |
|---|
| 1251 | ! |
|---|
| 1252 | REAL,DIMENSION(KTS:KTE-1) :: CM,CR,DTOZ,RSU,RSV |
|---|
| 1253 | !---------------------------------------------------------------------- |
|---|
| 1254 | !********************************************************************** |
|---|
| 1255 | !---------------------------------------------------------------------- |
|---|
| 1256 | DO K=1,LMH-1 |
|---|
| 1257 | DTOZ(K)=DTDIF/(Z(K)-Z(K+1)) |
|---|
| 1258 | CR(K)=-DTOZ(K)*RKM(K) |
|---|
| 1259 | ENDDO |
|---|
| 1260 | ! |
|---|
| 1261 | RHOK=RHO(1) |
|---|
| 1262 | CM(1)=DTOZ(1)*RKM(1)+RHOK |
|---|
| 1263 | RSU(1)=U(1)*RHOK |
|---|
| 1264 | RSV(1)=V(1)*RHOK |
|---|
| 1265 | !---------------------------------------------------------------------- |
|---|
| 1266 | DO K=2,LMH-1 |
|---|
| 1267 | DTOZL=DTOZ(K) |
|---|
| 1268 | CF=-DTOZL*RKM(K-1)/CM(K-1) |
|---|
| 1269 | RHOK=RHO(K) |
|---|
| 1270 | CM(K)=-CR(K-1)*CF+(RKM(K-1)+RKM(K))*DTOZL+RHOK |
|---|
| 1271 | RSU(K)=-RSU(K-1)*CF+U(K)*RHOK |
|---|
| 1272 | RSV(K)=-RSV(K-1)*CF+V(K)*RHOK |
|---|
| 1273 | ENDDO |
|---|
| 1274 | !---------------------------------------------------------------------- |
|---|
| 1275 | DTOZS=DTDIF/(Z(LMH)-Z(LMH+1)) |
|---|
| 1276 | RKMH=RKM(LMH-1) |
|---|
| 1277 | ! |
|---|
| 1278 | CF=-DTOZS*RKMH/CM(LMH-1) |
|---|
| 1279 | RHOK=RHO(LMH) |
|---|
| 1280 | RCMVB=1./((RKMH+RKMS)*DTOZS-CR(LMH-1)*CF+RHOK) |
|---|
| 1281 | DTOZAK=DTOZS*RKMS |
|---|
| 1282 | !---------------------------------------------------------------------- |
|---|
| 1283 | U(LMH)=(DTOZAK*UZ0-RSU(LMH-1)*CF+U(LMH)*RHOK)*RCMVB |
|---|
| 1284 | V(LMH)=(DTOZAK*VZ0-RSV(LMH-1)*CF+V(LMH)*RHOK)*RCMVB |
|---|
| 1285 | !---------------------------------------------------------------------- |
|---|
| 1286 | DO K=LMH-1,1,-1 |
|---|
| 1287 | RCML=1./CM(K) |
|---|
| 1288 | U(K)=(-CR(K)*U(K+1)+RSU(K))*RCML |
|---|
| 1289 | V(K)=(-CR(K)*V(K+1)+RSV(K))*RCML |
|---|
| 1290 | ENDDO |
|---|
| 1291 | !---------------------------------------------------------------------- |
|---|
| 1292 | ! |
|---|
| 1293 | END SUBROUTINE VDIFV |
|---|
| 1294 | ! |
|---|
| 1295 | !----------------------------------------------------------------------- |
|---|
| 1296 | ! |
|---|
| 1297 | !======================================================================= |
|---|
| 1298 | SUBROUTINE QNSEPBLINIT(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & |
|---|
| 1299 | & TKE,EXCH_H,RESTART,ALLOWED_TO_READ, & |
|---|
| 1300 | & IDS,IDE,JDS,JDE,KDS,KDE, & |
|---|
| 1301 | & IMS,IME,JMS,JME,KMS,KME, & |
|---|
| 1302 | & ITS,ITE,JTS,JTE,KTS,KTE ) |
|---|
| 1303 | !----------------------------------------------------------------------- |
|---|
| 1304 | IMPLICIT NONE |
|---|
| 1305 | !----------------------------------------------------------------------- |
|---|
| 1306 | LOGICAL,INTENT(IN) :: ALLOWED_TO_READ,RESTART |
|---|
| 1307 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, & |
|---|
| 1308 | & IMS,IME,JMS,JME,KMS,KME, & |
|---|
| 1309 | & ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 1310 | |
|---|
| 1311 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: EXCH_H, & |
|---|
| 1312 | & RUBLTEN, & |
|---|
| 1313 | & RVBLTEN, & |
|---|
| 1314 | & RTHBLTEN, & |
|---|
| 1315 | & RQVBLTEN, & |
|---|
| 1316 | & TKE |
|---|
| 1317 | INTEGER :: I,J,K,ITF,JTF,KTF |
|---|
| 1318 | !----------------------------------------------------------------------- |
|---|
| 1319 | !----------------------------------------------------------------------- |
|---|
| 1320 | |
|---|
| 1321 | JTF=MIN0(JTE,JDE-1) |
|---|
| 1322 | KTF=MIN0(KTE,KDE-1) |
|---|
| 1323 | ITF=MIN0(ITE,IDE-1) |
|---|
| 1324 | |
|---|
| 1325 | IF(.NOT.RESTART)THEN |
|---|
| 1326 | DO J=JTS,JTF |
|---|
| 1327 | DO K=KTS,KTF |
|---|
| 1328 | DO I=ITS,ITF |
|---|
| 1329 | TKE(I,K,J)=EPSQ2L |
|---|
| 1330 | RUBLTEN(I,K,J)=0. |
|---|
| 1331 | RVBLTEN(I,K,J)=0. |
|---|
| 1332 | RTHBLTEN(I,K,J)=0. |
|---|
| 1333 | RQVBLTEN(I,K,J)=0. |
|---|
| 1334 | EXCH_H(I,K,J)=0. |
|---|
| 1335 | ENDDO |
|---|
| 1336 | ENDDO |
|---|
| 1337 | ENDDO |
|---|
| 1338 | ENDIF |
|---|
| 1339 | |
|---|
| 1340 | END SUBROUTINE QNSEPBLINIT |
|---|
| 1341 | !----------------------------------------------------------------------- |
|---|
| 1342 | ! |
|---|
| 1343 | END MODULE MODULE_BL_QNSEPBL |
|---|
| 1344 | ! |
|---|
| 1345 | !----------------------------------------------------------------------- |
|---|