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