178 type(surface),
intent(inout) :: state
179 type(forcing),
intent(inout) :: fluxes
180 type(time_type),
intent(in) :: day
181 real,
intent(in) :: dt
183 type(ocean_grid_type),
intent(in) :: g
184 type(meso_surface_forcing_cs),
pointer :: cs
212 real :: salin_restore
213 real :: density_restore
216 real :: buoy_rest_const
219 integer :: i, j, is, ie, js, je
220 integer :: isd, ied, jsd, jed
222 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
223 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
230 if (cs%use_temperature)
then 231 call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed)
232 call alloc_if_needed(fluxes%lprec, isd, ied, jsd, jed)
233 call alloc_if_needed(fluxes%fprec, isd, ied, jsd, jed)
234 call alloc_if_needed(fluxes%lrunoff, isd, ied, jsd, jed)
235 call alloc_if_needed(fluxes%frunoff, isd, ied, jsd, jed)
236 call alloc_if_needed(fluxes%vprec, isd, ied, jsd, jed)
238 call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed)
239 call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed)
240 call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed)
241 call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed)
242 call alloc_if_needed(fluxes%heat_content_lprec, isd, ied, jsd, jed)
244 call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed)
249 if (cs%restorebuoy .and. first_call)
then 250 call alloc_if_needed(cs%T_Restore, isd, ied, jsd, jed)
251 call alloc_if_needed(cs%S_Restore, isd, ied, jsd, jed)
252 call alloc_if_needed(cs%Heat, isd, ied, jsd, jed)
253 call alloc_if_needed(cs%PmE, isd, ied, jsd, jed)
254 call alloc_if_needed(cs%Solar, isd, ied, jsd, jed)
256 call read_data(trim(cs%inputdir)//trim(cs%SSTrestore_file),
"SST", &
257 cs%T_Restore(:,:), domain=g%Domain%mpp_domain)
258 call read_data(trim(cs%inputdir)//trim(cs%salinityrestore_file),
"SAL", &
259 cs%S_Restore(:,:), domain=g%Domain%mpp_domain)
260 call read_data(trim(cs%inputdir)//trim(cs%heating_file),
"Heat", &
261 cs%Heat(:,:), domain=g%Domain%mpp_domain)
262 call read_data(trim(cs%inputdir)//trim(cs%PmE_file),
"PmE", &
263 cs%PmE(:,:), domain=g%Domain%mpp_domain)
264 call read_data(trim(cs%inputdir)//trim(cs%Solar_file),
"NET_SOL", &
265 cs%Solar(:,:), domain=g%Domain%mpp_domain)
269 if ( cs%use_temperature )
then 272 do j=js,je ;
do i=is,ie
275 fluxes%evap(i,j) = -0.0 * g%mask2dT(i,j)
276 fluxes%lprec(i,j) = cs%PmE(i,j) * cs%Rho0 * g%mask2dT(i,j)
279 fluxes%vprec(i,j) = 0.0
282 fluxes%lw(i,j) = 0.0 * g%mask2dT(i,j)
283 fluxes%latent(i,j) = 0.0 * g%mask2dT(i,j)
284 fluxes%sens(i,j) = cs%Heat(i,j) * g%mask2dT(i,j)
285 fluxes%sw(i,j) = cs%Solar(i,j) * g%mask2dT(i,j)
288 do j=js,je ;
do i=is,ie
291 fluxes%buoy(i,j) = 0.0 * g%mask2dT(i,j)
295 if (cs%restorebuoy)
then 296 if (cs%use_temperature)
then 297 call alloc_if_needed(fluxes%heat_added, isd, ied, jsd, jed)
303 rhoxcp = cs%Rho0 * fluxes%C_p
304 do j=js,je ;
do i=is,ie
307 if (g%mask2dT(i,j) > 0)
then 308 fluxes%heat_added(i,j) = g%mask2dT(i,j) * &
309 ((cs%T_Restore(i,j) - state%SST(i,j)) * rhoxcp * cs%Flux_const)
310 fluxes%vprec(i,j) = - (cs%Rho0*cs%Flux_const) * &
311 (cs%S_Restore(i,j) - state%SSS(i,j)) / &
312 (0.5*(state%SSS(i,j) + cs%S_Restore(i,j)))
314 fluxes%heat_added(i,j) = 0.0
315 fluxes%vprec(i,j) = 0.0
321 call mom_error(fatal,
"MESO_buoyancy_surface_forcing: " // &
322 "Buoyancy restoring used without modification." )
325 buoy_rest_const = -1.0 * (cs%G_Earth * cs%Flux_const) / cs%Rho0
326 do j=js,je ;
do i=is,ie
329 density_restore = 1030.0
331 fluxes%buoy(i,j) = g%mask2dT(i,j) * buoy_rest_const * &
332 (density_restore - state%sfc_density(i,j))