| 1 | MODULE orodrag_mod |
|---|
| 2 | |
|---|
| 3 | IMPLICIT NONE |
|---|
| 4 | |
|---|
| 5 | CONTAINS |
|---|
| 6 | |
|---|
| 7 | SUBROUTINE ORODRAG( klon,klev |
|---|
| 8 | I , KGWD, KGWDIM, KDX, KTEST |
|---|
| 9 | R , PTSPHY |
|---|
| 10 | R , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1 |
|---|
| 11 | R , PVM1, PVAROR, PSIG, PGAMMA, PTHETA |
|---|
| 12 | C OUTPUTS |
|---|
| 13 | R , PULOW,PVLOW |
|---|
| 14 | R , PVOM,PVOL,PTE ) |
|---|
| 15 | C |
|---|
| 16 | C |
|---|
| 17 | C**** *ORODRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION. |
|---|
| 18 | C |
|---|
| 19 | C PURPOSE. |
|---|
| 20 | C -------- |
|---|
| 21 | C |
|---|
| 22 | C THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE |
|---|
| 23 | C PROGNOSTIC VARIABLES U,V AND T DUE TO VERTICAL TRANSPORTS BY |
|---|
| 24 | C SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES |
|---|
| 25 | C |
|---|
| 26 | C EXPLICIT ARGUMENTS : |
|---|
| 27 | C -------------------- |
|---|
| 28 | C |
|---|
| 29 | C INPUT : |
|---|
| 30 | C |
|---|
| 31 | C NLON : NUMBER OF HORIZONTAL GRID POINTS |
|---|
| 32 | C NLEV : NUMBER OF LEVELS |
|---|
| 33 | C KGWD : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED |
|---|
| 34 | C KGWDIM : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED |
|---|
| 35 | C KDX(NLON) : POINTS AT WHICH TO CALL THE SCHEME |
|---|
| 36 | C KTEST(NLON) : MAP OF CALLING POINTS |
|---|
| 37 | C PTSPHY : LENGTH OF TIME STEP |
|---|
| 38 | C PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS |
|---|
| 39 | C PAPM1(NLON,NLEV) : PRESSURE ON MODEL LEVELS |
|---|
| 40 | C PGEOM1(NLON,NLEV) : GEOPOTENTIAL HIEGHT OF MODEL LEVELS |
|---|
| 41 | C PTM1(NLON,NLEV) : TEMPERATURE |
|---|
| 42 | C PUM1(NLON,NLEV) : ZONAL WIND |
|---|
| 43 | C PVM1(NLON,NLEV) : MERIDIONAL WIND |
|---|
| 44 | C PVAROR(NLON) : SUB-GRID SCALE STANDARD DEVIATION |
|---|
| 45 | C PSIG(NLON) : SUB-GRID SCALE SLOPE |
|---|
| 46 | C PGAMMA(NLON) : SUB-GRID SCALE ANISOTROPY |
|---|
| 47 | C PTHETA(NLON) : SUB-GRID SCALE PRINCIPAL AXES ANGLE |
|---|
| 48 | C |
|---|
| 49 | C OUTPUT : |
|---|
| 50 | C |
|---|
| 51 | C PULOW(NLON) : LOW LEVEL ZONAL WIND |
|---|
| 52 | C PVLOW(NLON) : LOW LEVEL MERIDIONAL WIND |
|---|
| 53 | C PVOM(NLON,NLEV) : ZONAL WIND TENDENCY |
|---|
| 54 | C PVOL(NLON,NLEV) : MERIDIONAL WIND TENDENCY |
|---|
| 55 | C PTE(NLON,NLEV) : TEMPERATURE TENDENCY |
|---|
| 56 | C |
|---|
| 57 | C IMPLICIT ARGUMENTS : |
|---|
| 58 | C -------------------- |
|---|
| 59 | C |
|---|
| 60 | C comcstfi.h |
|---|
| 61 | C yoegwd.h |
|---|
| 62 | C |
|---|
| 63 | C METHOD. |
|---|
| 64 | C ------- |
|---|
| 65 | C |
|---|
| 66 | C EXTERNALS. |
|---|
| 67 | C ---------- |
|---|
| 68 | C |
|---|
| 69 | C REFERENCE. |
|---|
| 70 | C ---------- |
|---|
| 71 | C |
|---|
| 72 | C AUTHOR. |
|---|
| 73 | C ------- |
|---|
| 74 | C M.MILLER + B.RITTER E.C.M.W.F. 15/06/86. |
|---|
| 75 | C |
|---|
| 76 | C F.LOTT + M. MILLER E.C.M.W.F. 22/11/94 |
|---|
| 77 | C----------------------------------------------------------------------- |
|---|
| 78 | use dimradmars_mod, only: ndlo2 |
|---|
| 79 | USE gwstress_mod, ONLY: gwstress |
|---|
| 80 | USE gwprofil_mod, ONLY: gwprofil |
|---|
| 81 | USE comcstfi_h, ONLY: g, cpp |
|---|
| 82 | implicit none |
|---|
| 83 | C |
|---|
| 84 | C |
|---|
| 85 | integer klon,klev,kidia |
|---|
| 86 | parameter(kidia=1) |
|---|
| 87 | integer, save :: kfdia ! =NDLO2 |
|---|
| 88 | |
|---|
| 89 | !$OMP THREADPRIVATE(kfdia) |
|---|
| 90 | |
|---|
| 91 | include "yoegwd.h" |
|---|
| 92 | C----------------------------------------------------------------------- |
|---|
| 93 | C |
|---|
| 94 | C* 0.1 ARGUMENTS |
|---|
| 95 | C --------- |
|---|
| 96 | C |
|---|
| 97 | C |
|---|
| 98 | REAL PTE(NDLO2,klev), |
|---|
| 99 | * PVOL(NDLO2,klev), |
|---|
| 100 | * PVOM(NDLO2,klev), |
|---|
| 101 | * PULOW(NDLO2), |
|---|
| 102 | * PVLOW(NDLO2) |
|---|
| 103 | REAL PUM1(NDLO2,klev), |
|---|
| 104 | * PVM1(NDLO2,klev), |
|---|
| 105 | * PTM1(NDLO2,klev), |
|---|
| 106 | * PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2), |
|---|
| 107 | * PGEOM1(NDLO2,klev), |
|---|
| 108 | * PAPM1(NDLO2,klev), |
|---|
| 109 | * PAPHM1(NDLO2,klev+1) |
|---|
| 110 | C |
|---|
| 111 | integer kgwd,kgwdim |
|---|
| 112 | real ptsphy |
|---|
| 113 | INTEGER KDX(NDLO2),KTEST(NDLO2) |
|---|
| 114 | C----------------------------------------------------------------------- |
|---|
| 115 | C |
|---|
| 116 | C* 0.2 LOCAL ARRAYS |
|---|
| 117 | C ------------ |
|---|
| 118 | INTEGER ISECT(NDLO2), |
|---|
| 119 | * ICRIT(NDLO2), |
|---|
| 120 | * IKCRITH(NDLO2), |
|---|
| 121 | * IKenvh(NDLO2), |
|---|
| 122 | * IKNU(NDLO2), |
|---|
| 123 | * IKNU2(NDLO2), |
|---|
| 124 | * IKCRIT(NDLO2), |
|---|
| 125 | * IKHLIM(NDLO2) |
|---|
| 126 | integer ji,jk,jl,klevm1,ilevp1 |
|---|
| 127 | C real gkwake |
|---|
| 128 | real ztmst,pvar(NDLO2,4),ztauf(NDLO2,klev+1) |
|---|
| 129 | real zrtmst,zdelp,zb,zc,zbet |
|---|
| 130 | real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp |
|---|
| 131 | C |
|---|
| 132 | REAL ZTAU(NDLO2,klev+1), |
|---|
| 133 | * ZSTAB(NDLO2,klev+1), |
|---|
| 134 | * ZVPH(NDLO2,klev+1), |
|---|
| 135 | * ZRHO(NDLO2,klev+1), |
|---|
| 136 | * ZRI(NDLO2,klev+1), |
|---|
| 137 | * ZpsI(NDLO2,klev+1), |
|---|
| 138 | * Zzdep(NDLO2,klev) |
|---|
| 139 | REAL ZDUDT(NDLO2), |
|---|
| 140 | * ZDVDT(NDLO2), |
|---|
| 141 | * ZDTDT(NDLO2), |
|---|
| 142 | * ZDEDT(NDLO2), |
|---|
| 143 | * ZVIDIS(NDLO2), |
|---|
| 144 | * ZTFR(NDLO2), |
|---|
| 145 | * Znu(NDLO2), |
|---|
| 146 | * Zd1(NDLO2), |
|---|
| 147 | * Zd2(NDLO2), |
|---|
| 148 | * Zdmod(NDLO2) |
|---|
| 149 | C |
|---|
| 150 | C------------------------------------------------------------------ |
|---|
| 151 | C |
|---|
| 152 | C* 1. INITIALIZATION |
|---|
| 153 | C -------------- |
|---|
| 154 | C |
|---|
| 155 | 100 CONTINUE |
|---|
| 156 | C |
|---|
| 157 | C ------------------------------------------------------------------ |
|---|
| 158 | C |
|---|
| 159 | C* 1.1 COMPUTATIONAL CONSTANTS |
|---|
| 160 | C ----------------------- |
|---|
| 161 | C |
|---|
| 162 | 110 CONTINUE |
|---|
| 163 | C |
|---|
| 164 | kfdia=NDLO2 |
|---|
| 165 | |
|---|
| 166 | c ZTMST=TWODT |
|---|
| 167 | c IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT |
|---|
| 168 | KLEVM1=KLEV-1 |
|---|
| 169 | ZTMST=PTSPHY |
|---|
| 170 | ZRTMST=1./ZTMST |
|---|
| 171 | C ------------------------------------------------------------------ |
|---|
| 172 | C |
|---|
| 173 | 120 CONTINUE |
|---|
| 174 | C |
|---|
| 175 | C ------------------------------------------------------------------ |
|---|
| 176 | C |
|---|
| 177 | C* 1.3 CHECK WHETHER ROW CONTAINS POINT FOR PRINTING |
|---|
| 178 | C --------------------------------------------- |
|---|
| 179 | C |
|---|
| 180 | 130 CONTINUE |
|---|
| 181 | C |
|---|
| 182 | C ------------------------------------------------------------------ |
|---|
| 183 | C |
|---|
| 184 | C* 2. PRECOMPUTE BASIC STATE VARIABLES. |
|---|
| 185 | C* ---------- ----- ----- ---------- |
|---|
| 186 | C* DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF |
|---|
| 187 | C* LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE |
|---|
| 188 | C* THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS. |
|---|
| 189 | C |
|---|
| 190 | 200 CONTINUE |
|---|
| 191 | C |
|---|
| 192 | C |
|---|
| 193 | C |
|---|
| 194 | CALL OROSETUP |
|---|
| 195 | * ( klon, klev , KTEST |
|---|
| 196 | * , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2 |
|---|
| 197 | * , PAPHM1, PAPM1 , PUM1 , PVM1 , PTM1 , PGEOM1, pvaror |
|---|
| 198 | * , ZRHO , ZRI , ZSTAB , ZTAU , ZVPH , zpsi, zzdep |
|---|
| 199 | * , PULOW, PVLOW |
|---|
| 200 | * , ptheta,pgamma,znu ,zd1, zd2, zdmod ) |
|---|
| 201 | C |
|---|
| 202 | C |
|---|
| 203 | C |
|---|
| 204 | C*********************************************************** |
|---|
| 205 | C |
|---|
| 206 | C |
|---|
| 207 | C* 3. COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND |
|---|
| 208 | C* SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT |
|---|
| 209 | C* AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY. |
|---|
| 210 | C |
|---|
| 211 | 300 CONTINUE |
|---|
| 212 | C |
|---|
| 213 | CALL GWSTRESS |
|---|
| 214 | * ( klon , klev |
|---|
| 215 | * , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU |
|---|
| 216 | * , ZRHO , ZSTAB, ZVPH , PVAR , pvaror, psig |
|---|
| 217 | * , ZTFR , ZTAU |
|---|
| 218 | * , pgeom1,pgamma,zd1,zd2,zdmod,znu) |
|---|
| 219 | C |
|---|
| 220 | C* 4. COMPUTE STRESS PROFILE. |
|---|
| 221 | C* ------- ------ -------- |
|---|
| 222 | C |
|---|
| 223 | 400 CONTINUE |
|---|
| 224 | C |
|---|
| 225 | C |
|---|
| 226 | CALL GWPROFIL |
|---|
| 227 | * ( klon , klev |
|---|
| 228 | * , kgwd , kdx , KTEST |
|---|
| 229 | * , IKCRIT, IKCRITH, ICRIT , ikenvh, IKNU |
|---|
| 230 | * ,iknu2 , pAPHM1, ZRHO , ZSTAB , ZTFR , ZVPH |
|---|
| 231 | * , ZRI , ZTAU , ztauf |
|---|
| 232 | * , zdmod , znu , psig , pgamma , pvaror ) |
|---|
| 233 | C |
|---|
| 234 | C |
|---|
| 235 | C* 5. COMPUTE TENDENCIES. |
|---|
| 236 | C* ------------------- |
|---|
| 237 | C |
|---|
| 238 | 500 CONTINUE |
|---|
| 239 | C |
|---|
| 240 | C EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE |
|---|
| 241 | C IMPLICIT SOLUTION FOR THE BLOCKED LEVELS |
|---|
| 242 | |
|---|
| 243 | DO 510 JL=KIDIA,KFDIA |
|---|
| 244 | ZVIDIS(JL)=0.0 |
|---|
| 245 | ZDUDT(JL)=0.0 |
|---|
| 246 | ZDVDT(JL)=0.0 |
|---|
| 247 | ZDTDT(JL)=0.0 |
|---|
| 248 | 510 CONTINUE |
|---|
| 249 | C |
|---|
| 250 | ILEVP1=KLEV+1 |
|---|
| 251 | C |
|---|
| 252 | C |
|---|
| 253 | DO 524 JK=1,klev |
|---|
| 254 | C |
|---|
| 255 | CDIR$ IVDEP |
|---|
| 256 | C |
|---|
| 257 | C GKWAKE=0.5 |
|---|
| 258 | C |
|---|
| 259 | C NOW SET IN SUGWD.F |
|---|
| 260 | C |
|---|
| 261 | DO 523 JL=1,KGWD |
|---|
| 262 | JI=KDX(JL) |
|---|
| 263 | ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK) |
|---|
| 264 | ZTEMP=-g*(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)*ZDELP) |
|---|
| 265 | ZDUDT(JI)=(PULOW(JI)*Zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji) |
|---|
| 266 | ZDVDT(JI)=(pvLOW(JI)*Zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji) |
|---|
| 267 | if(jk.ge.ikenvh(ji)) then |
|---|
| 268 | zb=1.0-0.18*pgamma(ji)-0.04*pgamma(ji)**2 |
|---|
| 269 | zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2 |
|---|
| 270 | zconb=2.*ztmst*GKWAKE*psig(ji)/(4.*pvaror(ji)) |
|---|
| 271 | zabsv=sqrt(PUM1(JI,JK)**2+PVM1(JI,JK)**2)/2. |
|---|
| 272 | zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2 |
|---|
| 273 | ratio=(cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji,jk))**2)/ |
|---|
| 274 | * (pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2) |
|---|
| 275 | zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv |
|---|
| 276 | zdudt(ji)=-pum1(ji,jk)/ztmst |
|---|
| 277 | zdvdt(ji)=-pvm1(ji,jk)/ztmst |
|---|
| 278 | zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet)) |
|---|
| 279 | zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet)) |
|---|
| 280 | end if |
|---|
| 281 | PVOM(JI,JK)=ZDUDT(JI) |
|---|
| 282 | PVOL(JI,JK)=ZDVDT(JI) |
|---|
| 283 | ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI) |
|---|
| 284 | ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI) |
|---|
| 285 | ZDIS=0.5*(PUM1(JI,JK)**2+PVM1(JI,JK)**2-ZUST**2-ZVST**2) |
|---|
| 286 | ZDEDT(JI)=ZDIS/ZTMST |
|---|
| 287 | ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP |
|---|
| 288 | ZDTDT(JI)=ZDEDT(JI)/cpp |
|---|
| 289 | PTE(JI,JK)=ZDTDT(JI) |
|---|
| 290 | |
|---|
| 291 | 523 CONTINUE |
|---|
| 292 | |
|---|
| 293 | 524 CONTINUE |
|---|
| 294 | C |
|---|
| 295 | C |
|---|
| 296 | |
|---|
| 297 | END SUBROUTINE ORODRAG |
|---|
| 298 | |
|---|
| 299 | END MODULE orodrag_mod |
|---|
