module_microphysics_zero_out.F

References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:PHYSICS
2 !
3 MODULE module_microphysics_zero_out
4 CONTAINS
5 
6 SUBROUTINE 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 
125 END MODULE module_microphysics_zero_out
126 
127 
128