source: trunk/WRF.COMMON/WRFV2/phys/module_microphysics_zero_out.F @ 3094

Last change on this file since 3094 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 4.1 KB
Line 
1!WRF:MEDIATION_LAYER:PHYSICS
2!
3MODULE module_microphysics_zero_out
4CONTAINS
5
6SUBROUTINE microphysics_zero_out (                                       &
7                       moist_new , n_moist                               &
8                      ,config_flags                                      &
9                      ,ids,ide, jds,jde, kds,kde                         &
10                      ,ims,ime, jms,jme, kms,kme                         &
11                      ,its,ite, jts,jte, kts,kte                         )
12
13
14   USE module_state_description
15   USE module_configure
16   USE module_wrf_error
17
18   IMPLICIT NONE
19   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
20   INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
21   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
22   INTEGER,      INTENT(IN   )    ::       its,ite, jts,jte, kts,kte
23
24   INTEGER,      INTENT(IN   )    :: n_moist
25
26   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist_new
27
28! Local
29
30   INTEGER i,j,k,n
31
32
33   ! Zero out small condensate values  FSL-BLS-12-JUL-2004
34
35   IF ( config_flags%mp_zero_out .EQ. 0 ) THEN
36      !  do nothing
37   ELSE IF ( config_flags%mp_zero_out .EQ. 1 ) THEN
38      !  All of the "moist" fields, except for vapor, that are below a critical
39      !  threshold are set to zero.
40      CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')
41      DO n = PARAM_FIRST_SCALAR,n_moist
42         IF ( n .NE. P_QV ) THEN
43            DO j = jts, jte
44            DO k = kts, kte
45            DO i = its, ite
46               IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
47            ENDDO
48            ENDDO
49            ENDDO
50         END IF
51      ENDDO
52   ELSE IF ( config_flags%mp_zero_out .EQ. 2 ) then
53      !  All of the non-Qv "moist" fields that are below a critical threshold are set to
54      !  zero.  The vapor is constrained to be non-negative.
55      CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')
56      DO n = PARAM_FIRST_SCALAR,n_moist
57         IF ( n .NE. P_QV ) THEN
58            DO j = jts, jte
59            DO k = kts, kte
60            DO i = its, ite
61               IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
62            ENDDO
63            ENDDO
64            ENDDO
65         ELSE IF ( n .EQ. P_QV ) THEN
66            DO j = jts, jte
67            DO k = kts, kte
68            DO i = its, ite
69               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
70            ENDDO
71            ENDDO
72            ENDDO
73         END IF
74      ENDDO
75   END IF
76
77   ! Make sure that the boundary is .GE. 0 if the config_flags%mp_zero_out option is selected (1 or 2)
78   ! Just do the outer row/col, no interior points.
79
80   IF ( config_flags%mp_zero_out .NE. 0 ) THEN
81      DO n = PARAM_FIRST_SCALAR,n_moist
82         !  bottom row
83         j = jds
84         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
85            DO k = kts, kte
86            DO i = its , MIN ( ite , ide-1 )
87               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
88            ENDDO
89            ENDDO
90         END IF
91         !  top row
92         j = jde-1
93         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
94            DO k = kts, kte
95            DO i = its , MIN ( ite , ide-1 )
96               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
97            ENDDO
98            ENDDO
99         END IF
100         !  left column
101         i = ids
102         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
103            DO j = jts , MIN ( jte , jde-1 )
104            DO k = kts, kte
105               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
106            ENDDO
107            ENDDO
108         END IF
109         !  right column
110         i = ide-1
111         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
112            DO j = jts , MIN ( jte , jde-1 )
113            DO k = kts, kte
114               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
115            ENDDO
116            ENDDO
117         END IF
118      ENDDO
119   END IF
120
121   RETURN
122
123   END SUBROUTINE microphysics_zero_out
124
125END MODULE module_microphysics_zero_out
126
127
128
Note: See TracBrowser for help on using the repository browser.