| [2759] | 1 | !WRF:MODEL_LAYER:DYNAMICS |
|---|
| 2 | ! |
|---|
| 3 | MODULE module_damping_em |
|---|
| 4 | |
|---|
| 5 | USE module_wrf_error |
|---|
| 6 | |
|---|
| 7 | CONTAINS |
|---|
| 8 | |
|---|
| 9 | !------------------------------------------------------------------------------ |
|---|
| 10 | |
|---|
| 11 | SUBROUTINE held_suarez_damp( ru_tend, rv_tend, ru, rv, p, pb, & |
|---|
| 12 | ids,ide, jds,jde, kds,kde, & |
|---|
| 13 | ims,ime, jms,jme, kms,kme, & |
|---|
| 14 | its,ite, jts,jte, kts,kte ) |
|---|
| 15 | |
|---|
| 16 | IMPLICIT NONE |
|---|
| 17 | |
|---|
| 18 | INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde |
|---|
| 19 | INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme |
|---|
| 20 | INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte |
|---|
| 21 | |
|---|
| 22 | REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & |
|---|
| 23 | INTENT(INOUT) :: ru_tend, & |
|---|
| 24 | rv_tend |
|---|
| 25 | |
|---|
| 26 | REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & |
|---|
| 27 | INTENT(IN) :: ru, rv, p, pb |
|---|
| 28 | |
|---|
| 29 | integer :: i,j,k |
|---|
| 30 | |
|---|
| 31 | REAL :: delty,delthez,sigb,kka,kkf |
|---|
| 32 | REAL :: sig,sigterm,kkt,kkv,daylensec |
|---|
| 33 | |
|---|
| 34 | sigb=0.7 |
|---|
| 35 | daylensec=60.0*60.0*24.0 |
|---|
| 36 | kkf=1.0/daylensec |
|---|
| 37 | |
|---|
| 38 | ! fixed limits so no divide by zero, WCS 070509 |
|---|
| 39 | |
|---|
| 40 | DO j=max(jds+1,jts),min(jde-1,jte) |
|---|
| 41 | DO k=kts,MIN(kte,kde-1) |
|---|
| 42 | DO i=its,ite |
|---|
| 43 | |
|---|
| 44 | sig= (p(i,k,j-1)+pb(i,k,j-1)+p(i,k,j)+pb(i,k,j))/ & |
|---|
| 45 | (p(i,1,j-1)+pb(i,1,j-1)+p(i,1,j)+pb(i,1,j)) |
|---|
| 46 | sigterm=max(0.0,(sig-sigb)/(1.0-sigb)) |
|---|
| 47 | kkv=kkf*sigterm |
|---|
| 48 | rv_tend(i,k,j)=rv_tend(i,k,j)-kkv*rv(i,k,j) |
|---|
| 49 | |
|---|
| 50 | END DO |
|---|
| 51 | END DO |
|---|
| 52 | END DO |
|---|
| 53 | |
|---|
| 54 | DO j=jts,min(jde-1,jte) |
|---|
| 55 | DO k=kts,MIN(kte,kde-1) |
|---|
| 56 | DO i=its,ite |
|---|
| 57 | |
|---|
| 58 | sig= (p(i-1,k,j)+pb(i-1,k,j)+p(i,k,j)+pb(i,k,j))/ & |
|---|
| 59 | (p(i-1,1,j)+pb(i-1,1,j)+p(i,1,j)+pb(i,1,j)) |
|---|
| 60 | sigterm=max(0.0,(sig-sigb)/(1.0-sigb)) |
|---|
| 61 | kkv=kkf*sigterm |
|---|
| 62 | ru_tend(i,k,j)=ru_tend(i,k,j)-kkv*ru(i,k,j) |
|---|
| 63 | |
|---|
| 64 | END DO |
|---|
| 65 | END DO |
|---|
| 66 | END DO |
|---|
| 67 | |
|---|
| 68 | END SUBROUTINE held_suarez_damp |
|---|
| 69 | |
|---|
| 70 | !------------------------------------------------------------------------------ |
|---|
| 71 | |
|---|
| 72 | END MODULE module_damping_em |
|---|
