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