71 st_input , sm_input , landmask, sst, &
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 )
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
88 INTEGER ,
INTENT(IN) :: flag_sst, flag_soil_layers, flag_soil_levels
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
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
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
101 REAL ,
DIMENSION(ims:ime,num_soil_layers,jms:jme) ,
INTENT(OUT) :: tslb , smois
103 REAL ,
ALLOCATABLE ,
DIMENSION(:) :: zhave
105 logical :: debug_print = .false.
106 INTEGER :: i , j , l , lout , lin , lwant , lhave, k
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.'
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) ) )
120 if (debug_print)
write(0, fmt=
'(A)')
' Assume non-RUC LSM input'
121 ALLOCATE ( zhave( max(num_st_levels_input,num_soil_layers) ) )
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)
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
144 IF ( flag_soil_layers == 1 )
THEN
147 st_input(i,1,j) = tsk(i,j)
148 st_input(i,num_st_levels_input+2,j) = tmn(i,j)
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)
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
172 IF ( flag_soil_layers == 1 )
THEN
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)+ &
179 sm_input(i,num_sm_levels_input+2,j) = sm_input(i,num_sm_levels_input+1,j)
186 IF ( flag_soil_levels == 1 )
THEN
187 DO l = 1 , num_st_levels_input
188 zhave(l) = st_levels_input(l) / 100.
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
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) )
214 DO l = 1 , num_st_levels_input
215 zhave(l+1) = st_levels_input(l) / 100.
217 zhave(num_st_levels_input+2) = 300. / 100.
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
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) )
242 IF ( flag_soil_levels .EQ. 1 )
THEN
243 DO l = 1 , num_sm_levels_input
244 zhave(l) = sm_levels_input(l) / 100.
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
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) )
269 DO l = 1 , num_sm_levels_input
270 zhave(l+1) = sm_levels_input(l) / 100.
272 zhave(num_sm_levels_input+2) = 300. / 100.
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
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) )
294 IF ( flag_sst .EQ. 1 )
THEN
297 IF ( landmask(i,j) .LT. 0.5 )
THEN
298 DO l = 1 , num_soil_layers
299 tslb(i,l,j) = sst(i,j)
309 IF ( landmask(i,j) .LT. 0.5 )
THEN
310 DO l = 1 , num_soil_layers
311 tslb(i,l,j)= tsk(i,j)
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...