Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / dyn_em / module_damping_em.F
blob62bbdb338410f93c0abb9133959c1c5a16fe558f
1 !WRF:MODEL_LAYER:DYNAMICS
3 MODULE module_damping_em
5   USE module_wrf_error
7 CONTAINS
9 !------------------------------------------------------------------------------
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 )
16     IMPLICIT NONE
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
22     REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),          &
23           INTENT(INOUT) ::                         ru_tend, &
24                                                    rv_tend
26     REAL, DIMENSION( ims:ime , kms:kme, jms:jme ),          &
27           INTENT(IN) ::                            ru, rv, p, pb
29     integer :: i,j,k
31     REAL :: delty,delthez,sigb,kka,kkf
32     REAL :: sig,sigterm,kkt,kkv,daylensec
34     sigb=0.7
35     daylensec=60.0*60.0*24.0
36     kkf=1.0/daylensec
38 !  fixed limits so no divide by zero, WCS 070509
40     DO j=max(jds+1,jts),min(jde-1,jte)
41     DO k=kts,MIN(kte,kde-1)
42     DO i=its,ite
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)
50     END DO
51     END DO
52     END DO
54     DO j=jts,min(jde-1,jte)
55     DO k=kts,MIN(kte,kde-1)
56     DO i=its,ite
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)
64     END DO
65     END DO
66     END DO
68   END SUBROUTINE held_suarez_damp
70 !------------------------------------------------------------------------------
72 END MODULE module_damping_em