source: lmdz_wrf/trunk/WRFV3/phys/module_microphysics_zero_out.F @ 1539

Last change on this file since 1539 was 1, checked in by lfita, 11 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 5.1 KB
Line 
1!WRF:MEDIATION_LAYER:PHYSICS
2!
3MODULE module_microphysics_zero_out
4CONTAINS
5
6SUBROUTINE microphysics_zero_outa (                                      &
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
76END SUBROUTINE microphysics_zero_outa
77
78SUBROUTINE microphysics_zero_outb (                                      &
79                       moist_new , n_moist                               &
80                      ,config_flags                                      &
81                      ,ids,ide, jds,jde, kds,kde                         &
82                      ,ims,ime, jms,jme, kms,kme                         &
83                      ,its,ite, jts,jte, kts,kte                         )
84
85
86   USE module_state_description
87   USE module_configure
88   USE module_wrf_error
89
90   IMPLICIT NONE
91   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
92   INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
93   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
94   INTEGER,      INTENT(IN   )    ::       its,ite, jts,jte, kts,kte
95
96   INTEGER,      INTENT(IN   )    :: n_moist
97
98   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist_new
99
100! Local
101
102   INTEGER i,j,k,n
103
104   ! Make sure that the boundary is .GE. 0 if the config_flags%mp_zero_out option is selected (1 or 2)
105   ! Just do the outer row/col, no interior points.
106
107   IF ( config_flags%mp_zero_out .NE. 0 ) THEN
108      DO n = PARAM_FIRST_SCALAR,n_moist
109         !  bottom row
110         j = jds
111         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
112            DO k = kts, kte
113            DO i = its , MIN ( ite , ide-1 )
114               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
115            ENDDO
116            ENDDO
117         END IF
118         !  top row
119         j = jde-1
120         IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
121            DO k = kts, kte
122            DO i = its , MIN ( ite , ide-1 )
123               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
124            ENDDO
125            ENDDO
126         END IF
127         !  left column
128         i = ids
129         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
130            DO j = jts , MIN ( jte , jde-1 )
131            DO k = kts, kte
132               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
133            ENDDO
134            ENDDO
135         END IF
136         !  right column
137         i = ide-1
138         IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
139            DO j = jts , MIN ( jte , jde-1 )
140            DO k = kts, kte
141               moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
142            ENDDO
143            ENDDO
144         END IF
145      ENDDO
146   END IF
147
148   RETURN
149
150   END SUBROUTINE microphysics_zero_outb
151
152END MODULE module_microphysics_zero_out
153
154
155
Note: See TracBrowser for help on using the repository browser.