CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
module_soil_pre.F90
1
2
5module module_soil_pre
6
7!tgs Initialize RUC LSM levels, soil temp/moisture
8
9 implicit none
10
11 private
12
13 public init_soil_depth_3, init_soil_3_real
14
15contains
16
26 SUBROUTINE init_soil_depth_3 ( zs , dzs , num_soil_levels )
27
28 INTEGER, INTENT(IN) :: num_soil_levels
29
30 REAL, DIMENSION(1:num_soil_levels), INTENT(OUT) :: zs, dzs
31 REAL, DIMENSION(1:num_soil_levels) :: zs2
32
33 INTEGER :: l
34
35 CHARACTER (LEN=132) :: message
36
37! in RUC LSM ZS - soil levels, and DZS - soil layer thicknesses, not used
38! ZS is specified in the namelist: num_soil_levels = 6 or 9.
39! Other options with number of levels are possible, but
40! WRF users should change consistently the namelist entry with the
41! ZS array in this subroutine.
42
43 IF ( num_soil_levels .EQ. 6) THEN
44 zs = (/ 0.00 , 0.05 , 0.20 , 0.40 , 1.60 , 3.00 /)
45 ELSEIF ( num_soil_levels .EQ. 9) THEN
46 zs = (/ 0.00 , 0.01 , 0.04 , 0.10 , 0.30, 0.60, 1.00 , 1.60, 3.00 /)
47 !zs = (/ 0.00 , 0.05 , 0.20 , 0.40 , 0.60, 1.00, 1.60 , 2.20, 3.00 /)
48 ENDIF
49
50 zs2(1) = 0.
51 zs2(2) = (zs(2) + zs(1))*0.5
52 dzs(1) = zs2(2) - zs2(1)
53 do l = 2, num_soil_levels - 1
54 zs2(l) = (zs(l+1) + zs(l)) * 0.5
55 dzs(l) = zs2(l) - zs2(l-1)
56 enddo
57 zs2(num_soil_levels) = zs(num_soil_levels)
58 dzs(num_soil_levels) = zs2(num_soil_levels) - zs2(num_soil_levels-1)
59
60 IF ( num_soil_levels .EQ. 4 .OR. num_soil_levels .EQ. 5 ) THEN
61 WRITE(message,fmt= '(A)')'Usually, the RUC LSM uses 6, 9 or more levels. Change this in the namelist.'
62! CALL wrf_error_fatal ( message )
63 END IF
64
65 END SUBROUTINE init_soil_depth_3
66
71 SUBROUTINE init_soil_3_real ( tsk , tmn , smois , tslb , &
72 st_input , sm_input , landmask, sst, &
73 zs , dzs , &
74 st_levels_input , sm_levels_input , &
75 num_soil_layers , num_st_levels_input , num_sm_levels_input , &
76 num_st_levels_alloc , num_sm_levels_alloc , &
77 flag_sst , flag_soil_layers , flag_soil_levels , &
78 ids , ide , jds , jde , kds , kde , &
79 ims , ime , jms , jme , kms , kme , &
80 its , ite , jts , jte , kts , kte )
81
82 INTEGER , INTENT(IN) :: num_soil_layers , &
83 num_st_levels_input , num_sm_levels_input , &
84 num_st_levels_alloc , num_sm_levels_alloc , &
85 ids , ide , jds , jde , kds , kde , &
86 ims , ime , jms , jme , kms , kme , &
87 its , ite , jts , jte , kts , kte
88
89 INTEGER , INTENT(IN) :: flag_sst, flag_soil_layers, flag_soil_levels
90
91 INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
92 INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
93
94 REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
95 REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
96 REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
97
98 REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
99 REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
100 REAL , DIMENSION(num_soil_layers) :: zs , dzs
101
102 REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois
103
104 REAL , ALLOCATABLE , DIMENSION(:) :: zhave
105
106 logical :: debug_print = .false.
107 INTEGER :: i , j , l , lout , lin , lwant , lhave, k
108 REAL :: temp
109
110 ! Allocate the soil layer array used for interpolating.
111
112 IF ( ( num_st_levels_input .LE. 0 ) .OR. &
113 ( num_sm_levels_input .LE. 0 ) ) THEN
114 write (0, fmt='(A)')&
115'No input soil level data (either temperature or moisture, or both are missing). Required for RUC LSM.'
116 ELSE
117 IF ( flag_soil_levels == 1 ) THEN
118 if (debug_print) write(0, fmt='(A)') ' Assume RUC LSM input'
119 ALLOCATE ( zhave( max(num_st_levels_input,num_sm_levels_input) ) )
120 ELSE
121 if (debug_print) write(0, fmt='(A)') ' Assume non-RUC LSM input'
122 ALLOCATE ( zhave( max(num_st_levels_input,num_soil_layers) ) )
123 END IF
124 END IF
125
126 ! Sort the levels for temperature.
127
128 outert : DO lout = 1 , num_st_levels_input-1
129 innert : DO lin = lout+1 , num_st_levels_input
130 IF ( st_levels_input(lout) .GT. st_levels_input(lin) ) THEN
131 temp = st_levels_input(lout)
132 st_levels_input(lout) = st_levels_input(lin)
133 st_levels_input(lin) = nint(temp)
134 DO j = jts , jte
135 DO i = its ,ite
136 temp = st_input(i,lout,j)
137 st_input(i,lout,j) = st_input(i,lin,j)
138 st_input(i,lin,j) = temp
139 END DO
140 END DO
141 END IF
142 END DO innert
143 END DO outert
144
145 IF ( flag_soil_layers == 1 ) THEN
146 DO j = jts , jte
147 DO i = its , ite
148 st_input(i,1,j) = tsk(i,j)
149 st_input(i,num_st_levels_input+2,j) = tmn(i,j)
150 END DO
151 END DO
152 END IF
153
154 ! Sort the levels for moisture.
155
156 outerm: DO lout = 1 , num_sm_levels_input-1
157 innerm : DO lin = lout+1 , num_sm_levels_input
158 IF ( sm_levels_input(lout) .GT. sm_levels_input(lin) ) THEN
159 temp = sm_levels_input(lout)
160 sm_levels_input(lout) = sm_levels_input(lin)
161 sm_levels_input(lin) = nint(temp)
162 DO j = jts ,jte
163 DO i = its , ite
164 temp = sm_input(i,lout,j)
165 sm_input(i,lout,j) = sm_input(i,lin,j)
166 sm_input(i,lin,j) = temp
167 END DO
168 END DO
169 END IF
170 END DO innerm
171 END DO outerm
172
173 IF ( flag_soil_layers == 1 ) THEN
174 DO j = jts , jte
175 DO i = its , ite
176 sm_input(i,1,j) = (sm_input(i,2,j)-sm_input(i,3,j))/ &
177 (st_levels_input(2)-st_levels_input(1))*st_levels_input(1)+ &
178 sm_input(i,2,j)
179
180 sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
181 END DO
182 END DO
183 END IF
184
185 ! Here are the levels that we have from the input for temperature.
186
187 IF ( flag_soil_levels == 1 ) THEN
188 DO l = 1 , num_st_levels_input
189 zhave(l) = st_levels_input(l) / 100.
190 END DO
191
192
193 ! Interpolate between the layers we have (zhave) and those that we want
194 ! (zs).
195
196 z_wantt : DO lwant = 1 , num_soil_layers
197 z_havet : DO lhave = 1 , num_st_levels_input -1
198 IF ( ( zs(lwant) .GE. zhave(lhave ) ) .AND. &
199 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
200 DO j = jts , jte
201 DO i = its , ite
202 tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs(lwant) ) + &
203 st_input(i,lhave+1,j) * ( zs(lwant ) - zhave(lhave) ) ) / &
204 ( zhave(lhave+1) - zhave(lhave) )
205 END DO
206 END DO
207 EXIT z_havet
208 END IF
209 END DO z_havet
210 END DO z_wantt
211
212 ELSE
213
214 zhave(1) = 0.
215 DO l = 1 , num_st_levels_input
216 zhave(l+1) = st_levels_input(l) / 100.
217 END DO
218 zhave(num_st_levels_input+2) = 300. / 100.
219
220 ! Interpolate between the layers we have (zhave) and those that we want
221 ! (zs).
222
223 z_wantt_2 : DO lwant = 1 , num_soil_layers
224 z_havet_2 : DO lhave = 1 , num_st_levels_input +2
225 IF ( ( zs(lwant) .GE. zhave(lhave ) ) .AND. &
226 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
227 DO j = jts , jte
228 DO i = its , ite
229 tslb(i,lwant,j)= ( st_input(i,lhave,j ) * ( zhave(lhave+1) - zs(lwant) ) + &
230 st_input(i,lhave+1,j) * ( zs(lwant ) - zhave(lhave) ) ) / &
231 ( zhave(lhave+1) - zhave(lhave) )
232 END DO
233 END DO
234 EXIT z_havet_2
235 END IF
236 END DO z_havet_2
237 END DO z_wantt_2
238
239 END IF
240
241 ! Here are the levels that we have from the input for moisture.
242
243 IF ( flag_soil_levels .EQ. 1 ) THEN
244 DO l = 1 , num_sm_levels_input
245 zhave(l) = sm_levels_input(l) / 100.
246 END DO
247
248 ! Interpolate between the layers we have (zhave) and those that we
249 ! want (zs).
250
251 z_wantm : DO lwant = 1 , num_soil_layers
252 z_havem : DO lhave = 1 , num_sm_levels_input -1
253 IF ( ( zs(lwant) .GE. zhave(lhave ) ) .AND. &
254 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
255 DO j = jts , jte
256 DO i = its , ite
257 smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs(lwant) ) + &
258 sm_input(i,lhave+1,j) * ( zs(lwant ) - zhave(lhave) ) ) / &
259 ( zhave(lhave+1) - zhave(lhave) )
260 END DO
261 END DO
262 EXIT z_havem
263 END IF
264 END DO z_havem
265 END DO z_wantm
266
267 ELSE
268
269 zhave(1) = 0.
270 DO l = 1 , num_sm_levels_input
271 zhave(l+1) = sm_levels_input(l) / 100.
272 END DO
273 zhave(num_sm_levels_input+2) = 300. / 100.
274
275 z_wantm_2 : DO lwant = 1 , num_soil_layers
276 z_havem_2 : DO lhave = 1 , num_sm_levels_input +2
277 IF ( ( zs(lwant) .GE. zhave(lhave ) ) .AND. &
278 ( zs(lwant) .LE. zhave(lhave+1) ) ) THEN
279 DO j = jts , jte
280 DO i = its , ite
281 smois(i,lwant,j)= ( sm_input(i,lhave,j ) * ( zhave(lhave+1) - zs(lwant) ) + &
282 sm_input(i,lhave+1,j) * ( zs(lwant ) - zhave(lhave) ) ) / &
283 ( zhave(lhave+1) - zhave(lhave) )
284 END DO
285 END DO
286 EXIT z_havem_2
287 END IF
288 END DO z_havem_2
289 END DO z_wantm_2
290
291 END IF
292
293
294
295 IF ( flag_sst .EQ. 1 ) THEN
296 DO j = jts , jte
297 DO i = its , ite
298 IF ( landmask(i,j) .LT. 0.5 ) THEN
299 DO l = 1 , num_soil_layers
300 tslb(i,l,j) = sst(i,j)
301 tsk(i,j) = sst(i,j)
302 smois(i,l,j)= 1.0
303 END DO
304 END IF
305 END DO
306 END DO
307 ELSE
308 DO j = jts , jte
309 DO i = its , ite
310 IF ( landmask(i,j) .LT. 0.5 ) THEN
311 DO l = 1 , num_soil_layers
312 tslb(i,l,j)= tsk(i,j)
313 smois(i,l,j)= 1.0
314 END DO
315 END IF
316 END DO
317 END DO
318 END IF
319
320 DEALLOCATE (zhave)
321
322 END SUBROUTINE init_soil_3_real
323
324end module module_soil_pre
module_soil_pre::init_soil_depth_3
subroutine, public init_soil_depth_3(zs, dzs, num_soil_levels)
This subroutine defines level depth in soil and thickness of soil layers RUC LSM.
Definition module_soil_pre.F90:27
module_soil_pre::init_soil_3_real
subroutine, public init_soil_3_real(tsk, tmn, smois, tslb, st_input, sm_input, landmask, sst, zs, dzs, st_levels_input, sm_levels_input, num_soil_layers, num_st_levels_input, num_sm_levels_input, num_st_levels_alloc, num_sm_levels_alloc, flag_sst, flag_soil_layers, flag_soil_levels, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
This subroutine initializes soil moisture and temperature at RUC vertical levels from the Noah layers...
Definition module_soil_pre.F90:81
module_soil_pre
This module contains subroutines that initialize RUC LSM levels, soil temperature/moisture.
Definition module_soil_pre.F90:5