source: trunk/WRF.COMMON/WRFV3/dyn_em/module_damping_em.F @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 2.0 KB
Line 
1!WRF:MODEL_LAYER:DYNAMICS
2!
3MODULE module_damping_em
4
5  USE module_wrf_error
6
7CONTAINS
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
72END MODULE module_damping_em
Note: See TracBrowser for help on using the repository browser.