CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
GFS_surface_composites_pre.F90
1
3
5
6 use machine, only: kind_phys
7
8 implicit none
9
10 private
11
12 public gfs_surface_composites_pre_run
13
14 real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, epsln = 1.0e-10_kind_phys
15
16! real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue
17
18contains
19
23 subroutine gfs_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_lake_clm, &
24 flag_cice, cplflx, cplice, cplwav2atm, lsm, lsm_ruc, &
25 landfrac, lakefrac, lakedepth, oceanfrac, frland, &
26 dry, icy, lake, use_lake_model, wet, hice, cice, zorlo, zorll, zorli, &
27 snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, &
28 tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, &
29 weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, &
30 tisfc, tsurf_wat, tsurf_lnd, tsurf_ice, &
31 gflx_ice, tgice, islmsk, islmsk_cice, slmsk, qss, qss_wat, qss_lnd, qss_ice, &
32 min_lakeice, min_seaice, kdt, huge, errmsg, errflg)
33
34 implicit none
35
36 ! Interface variables
37 integer, intent(in ) :: im, lkm, kdt, lsm, lsm_ruc, iopt_lake, iopt_lake_clm
38 logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid
39 logical, dimension(:), intent(inout) :: flag_cice
40 logical, dimension(:), intent(inout) :: dry, icy, lake, wet
41 integer, dimension(:), intent(in ) :: use_lake_model
42 real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac
43 real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice
44 real(kind=kind_phys), dimension(:), intent( out) :: frland
45 real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, tisfc
46
47 real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl
48 real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, &
49 tprcp_lnd, tprcp_ice, tsfc_wat, tsurf_wat,tsurf_lnd, tsurf_ice, &
50 uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, &
51 qss_wat, qss_lnd, qss_ice, ep1d_ice, gflx_ice
52 real(kind=kind_phys), intent(in ) :: tgice
53 integer, dimension(:), intent(inout) :: islmsk, islmsk_cice
54 real(kind=kind_phys), dimension(:), intent(inout) :: slmsk
55 real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice, huge
56 !
57 real(kind=kind_phys), dimension(:), intent(inout) :: zorlo, zorll, zorli
58 !
59 real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice
60
61 real(kind=kind_phys) :: tem
62
63 ! CCPP error handling
64 character(len=*), intent(out) :: errmsg
65 integer, intent(out) :: errflg
66
67 ! Local variables
68 integer :: i
69 logical :: is_clm
70
71 ! Initialize CCPP error handling variables
72 errmsg = ''
73 errflg = 0
74
75 do i=1,im
76 if(use_lake_model(i) > 0) then
77 wet(i) = .true.
78 endif
79 enddo
80
81 if (frac_grid) then ! cice is ice fraction wrt water area
82 do i=1,im
83 frland(i) = landfrac(i)
84 if (frland(i) > zero) dry(i) = .true.
85 if (frland(i) < one) then
86 if (oceanfrac(i) > zero) then
87 if (cice(i) >= min_seaice) then
88 icy(i) = .true.
89 if (cplflx) then
90 islmsk_cice(i) = 4
91 flag_cice(i) = .true.
92 else
93 islmsk_cice(i) = 2
94 flag_cice(i) = .false.
95 endif
96 islmsk(i) = 2
97 else
98 cice(i) = zero
99 hice(i) = zero
100 flag_cice(i) = .false.
101 islmsk_cice(i) = 0
102 islmsk(i) = 0
103 icy(i) = .false.
104 endif
105 if (cice(i) < one) then
106 wet(i) = .true. ! some open ocean
107 if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice)
108 endif
109 else
110 if (cice(i) >= min_lakeice) then
111 icy(i) = .true.
112 islmsk(i) = 2
113 else
114 cice(i) = zero
115 hice(i) = zero
116 islmsk(i) = 0
117 icy(i) = .false.
118 endif
119 islmsk_cice(i) = islmsk(i)
120 flag_cice(i) = .false.
121 if (cice(i) < one) then
122 wet(i) = .true. ! some open lake
123 if (icy(i)) tsfco(i) = max(tisfc(i), tgice)
124 endif
125 endif
126 else ! all land
127 cice(i) = zero
128 hice(i) = zero
129 islmsk_cice(i) = 1
130 islmsk(i) = 1
131 wet(i) = .false.
132 icy(i) = .false.
133 flag_cice(i) = .false.
134 endif
135 enddo
136
137 else
138
139 do i = 1, im
140 if (islmsk(i) == 1) then
141! tsfcl(i) = tsfc(i)
142 dry(i) = .true.
143 frland(i) = one
144 cice(i) = zero
145 hice(i) = zero
146 icy(i) = .false.
147 else
148 frland(i) = zero
149 if (oceanfrac(i) > zero) then
150 if (cice(i) >= min_seaice) then
151 icy(i) = .true.
152 ! This cplice namelist option was added to deal with the
153 ! situation of the FV3ATM-HYCOM coupling without an active sea
154 ! ice (e.g., CICE6) component. By default, the cplice is true
155 ! when cplflx is .true. (e.g., for the S2S application).
156 ! Whereas, for the HAFS FV3ATM-HYCOM coupling, cplice is set as
157 ! .false.. In the future HAFS FV3ATM-MOM6 coupling, the cplflx
158 ! could be .true., while cplice being .false..
159 if (cplice .and. cplflx) then
160 islmsk_cice(i) = 4
161 flag_cice(i) = .true.
162 else
163 islmsk_cice(i) = 2
164 flag_cice(i) = .false.
165 endif
166 islmsk(i) = 2
167 else
168 cice(i) = zero
169 hice(i) = zero
170 flag_cice(i) = .false.
171 islmsk(i) = 0
172 islmsk_cice(i) = 0
173 icy(i) = .false.
174 endif
175 if (cice(i) < one) then
176 wet(i) = .true. ! some open ocean
177 if (cplice) then
178 if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice)
179 else
180 if (icy(i)) tsfco(i) = max(tisfc(i), tgice)
181 endif
182 endif
183 else ! Not ocean and not land
184 is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0
185 if (cice(i) >= min_lakeice) then
186 icy(i) = .true.
187 islmsk(i) = 2
188 else
189 cice(i) = zero
190 hice(i) = zero
191 islmsk(i) = 0
192 icy(i) = .false.
193 endif
194 islmsk_cice(i) = islmsk(i)
195 flag_cice(i) = .false.
196 if(is_clm) then
197 wet(i) = .true.
198 if (icy(i)) then
199 tsfco(i) = max(tisfc(i), tgice)
200 endif
201 else if(cice(i) < one) then
202 wet(i) = .true. ! some open lake
203 if (icy(i)) then
204 tsfco(i) = max(tisfc(i), tgice)
205 endif
206 endif
207 endif
208 endif
209 enddo
210 endif ! frac_grid
211
212 do i=1,im
213 tprcp_wat(i) = tprcp(i)
214 tprcp_lnd(i) = tprcp(i)
215 tprcp_ice(i) = tprcp(i)
216
217 if (wet(i)) then ! Water
218 uustar_wat(i) = uustar(i)
219 tsfc_wat(i) = tsfco(i)
220 tsurf_wat(i) = tsfco(i)
221 zorlo(i) = max(1.0e-5, min(one, zorlo(i)))
222 ! DH*
223 else
224 zorlo(i) = huge
225 ! *DH
226 endif
227 if (dry(i)) then ! Land
228 uustar_lnd(i) = uustar(i)
229 if(lsm /= lsm_ruc) weasd_lnd(i) = weasd(i)
230 tsurf_lnd(i) = tsfcl(i)
231 ! DH*
232 else
233 zorll(i) = huge
234 ! *DH
235 !mjz
236 tsfcl(i) = huge
237 endif
238 if (icy(i) .or. wet(i)) then ! init uustar_ice for all water/ice grids
239 uustar_ice(i) = uustar(i)
240 endif
241 if (icy(i)) then ! Ice
242 is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0
243 if(lsm /= lsm_ruc .and. .not.is_clm) then
244 weasd_ice(i) = weasd(i)
245 endif
246 tsurf_ice(i) = tisfc(i)
247 ep1d_ice(i) = zero
248 gflx_ice(i) = zero
249 zorli(i) = max(1.0e-5, min(one, zorli(i)))
250 ! DH*
251 else
252 zorli(i) = huge
253 ! *DH
254 endif
255 if (nint(slmsk(i)) /= 1) slmsk(i) = islmsk(i)
256 enddo
257
258!
259 if (frac_grid) then
260 do i=1,im
261 if (dry(i)) then
262 if (icy(i)) then
263 if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
264 tem = one / (cice(i)*(one-frland(i)))
265 snowd_ice(i) = max(zero, (snowd(i) - snowd_lnd(i)*frland(i)) * tem)
266 weasd_ice(i) = max(zero, (weasd(i) - weasd_lnd(i)*frland(i)) * tem)
267 endif
268 endif
269 elseif (icy(i)) then
270 if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
271 tem = one / cice(i)
272 snowd_lnd(i) = zero
273 snowd_ice(i) = snowd(i) * tem
274 weasd_lnd(i) = zero
275 weasd_ice(i) = weasd(i) * tem
276 endif
277 endif
278 enddo
279 elseif(lsm /= lsm_ruc) then ! do not do snow initialization with RUC lsm
280 do i=1,im
281 if (icy(i)) then
282 if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
283 snowd_lnd(i) = zero
284 weasd_lnd(i) = zero
285 tem = one / cice(i)
286 snowd_ice(i) = snowd(i) * tem
287 weasd_ice(i) = weasd(i) * tem
288 endif
289 endif
290 enddo
291 endif
292
293! write(0,*)' minmax of ice snow=',minval(snowd_ice),maxval(snowd_ice)
294
295 end subroutine gfs_surface_composites_pre_run
296