Skip to content

Commit

Permalink
Merge branch 'gustavo-marques-sync_dev_master_19Dec18' into dev/master
Browse files Browse the repository at this point in the history
  • Loading branch information
@adcroft
adcroft committed Feb 5, 2019
2 parents e6b57ba + fb27736 commit f9c260d
Show file tree
Hide file tree
Showing 7 changed files with 349 additions and 191 deletions.
182 changes: 104 additions & 78 deletions config_src/mct_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,32 +151,33 @@ module MOM_surface_forcing
! the elements, units, and conventions that exactly conform to the use for
! MOM-based coupled models.
type, public :: ice_ocean_boundary_type
real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2)
real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2)
real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2)
real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa)
real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa)
real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2)
real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s)
real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s)
real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2)
real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s)
real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s)
real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s)
real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s)
real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s)
real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2)
real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2)
real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2)
real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2)
real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere
real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2)
real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (kg/m2/s)
real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (kg/m2/s)
real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa)
real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa)
real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2)
real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2)
real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s)
real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s)
real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s)
real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2)
real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2)
real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s)
real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s)
real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s)
real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s)
real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2)
real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2)
real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2)
real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2)
real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere
!< on ocean surface (Pa)
real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2)
real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and
real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2)
real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and
!! ice-shelves, expressed as a coefficient
!! for divergence damping, as determined
!! outside of the ocean model in (m3/s)
Expand Down Expand Up @@ -250,6 +251,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
real :: delta_sst ! temporary storage for sst diff from restoring value

real :: C_p ! heat capacity of seawater ( J/(K kg) )
real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1.

call cpu_clock_begin(id_clock_forcing)

Expand Down Expand Up @@ -442,6 +444,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
if (associated(fluxes%sens)) &
fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0)

! sea ice and snow melt heat flux (W/m2)
if (associated(fluxes%seaice_melt_heat)) &
fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0)

! water flux due to sea ice and snow melt (kg/m2/s)
if (associated(fluxes%seaice_melt)) &
fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0)

! latent heat flux (W/m^2)
if (associated(fluxes%latent)) &
fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0)
Expand All @@ -461,17 +471,19 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
! salt flux
! more salt restoring logic
if (associated(fluxes%salt_flux)) &
fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j))
fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0))

if (associated(fluxes%salt_flux_in)) &
fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0)
fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0))

enddo; enddo

! adjust the NET fresh-water flux to zero, if flagged
if (CS%adjust_net_fresh_water_to_zero) then
sign_for_net_FW_bug = 1.
if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1.
do j=js,je ; do i=is,ie
net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + &
net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + &
(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + &
(fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j)
! The following contribution appears to be calculating the volume flux of sea-ice
Expand All @@ -480,9 +492,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system
! is constant.
! To do this correctly we will need a sea-ice melt field added to IOB. -AJA
! GMM: as stated above, the following is wrong. CIME deals with volume/mass and
! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively.
if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) &
net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * &
(fluxes%salt_flux(i,j) / CS%ice_salt_concentration)

net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j)
enddo; enddo

Expand Down Expand Up @@ -596,13 +611,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
forces%p_surf(i,j) = forces%p_surf_full(i,j)
endif

if (CS%use_limited_P_SSH) then
forces%p_surf_SSH => forces%p_surf
else
forces%p_surf_SSH => forces%p_surf_full
endif
end if
end do; end do
endif
enddo; enddo

if (CS%use_limited_P_SSH) then
forces%p_surf_SSH => forces%p_surf
else
forces%p_surf_SSH => forces%p_surf_full
endif

! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later
wind_stagger = AGRID
Expand Down Expand Up @@ -771,6 +787,8 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
IOB% u_flux (isc:iec,jsc:jec), &
IOB% v_flux (isc:iec,jsc:jec), &
IOB% t_flux (isc:iec,jsc:jec), &
IOB% seaice_melt_heat (isc:iec,jsc:jec),&
IOB% seaice_melt (isc:iec,jsc:jec), &
IOB% q_flux (isc:iec,jsc:jec), &
IOB% salt_flux (isc:iec,jsc:jec), &
IOB% lw_flux (isc:iec,jsc:jec), &
Expand All @@ -780,7 +798,6 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
IOB% sw_flux_nir_dif (isc:iec,jsc:jec), &
IOB% lprec (isc:iec,jsc:jec), &
IOB% fprec (isc:iec,jsc:jec), &
IOB% runoff (isc:iec,jsc:jec), &
IOB% ustar_berg (isc:iec,jsc:jec), &
IOB% area_berg (isc:iec,jsc:jec), &
IOB% mass_berg (isc:iec,jsc:jec), &
Expand All @@ -790,30 +807,31 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
IOB% mi (isc:iec,jsc:jec), &
IOB% p (isc:iec,jsc:jec))

IOB%latent_flux = 0.0
IOB%rofl_flux = 0.0
IOB%rofi_flux = 0.0
IOB%u_flux = 0.0
IOB%v_flux = 0.0
IOB%t_flux = 0.0
IOB%q_flux = 0.0
IOB%salt_flux = 0.0
IOB%lw_flux = 0.0
IOB%sw_flux_vis_dir = 0.0
IOB%sw_flux_vis_dif = 0.0
IOB%sw_flux_nir_dir = 0.0
IOB%sw_flux_nir_dif = 0.0
IOB%lprec = 0.0
IOB%fprec = 0.0
IOB%runoff = 0.0
IOB%ustar_berg = 0.0
IOB%area_berg = 0.0
IOB%mass_berg = 0.0
IOB%calving = 0.0
IOB%runoff_hflx = 0.0
IOB%calving_hflx = 0.0
IOB%mi = 0.0
IOB%p = 0.0
IOB%latent_flux = 0.0
IOB%rofl_flux = 0.0
IOB%rofi_flux = 0.0
IOB%u_flux = 0.0
IOB%v_flux = 0.0
IOB%t_flux = 0.0
IOB%seaice_melt_heat = 0.0
IOB%seaice_melt = 0.0
IOB%q_flux = 0.0
IOB%salt_flux = 0.0
IOB%lw_flux = 0.0
IOB%sw_flux_vis_dir = 0.0
IOB%sw_flux_vis_dif = 0.0
IOB%sw_flux_nir_dir = 0.0
IOB%sw_flux_nir_dif = 0.0
IOB%lprec = 0.0
IOB%fprec = 0.0
IOB%ustar_berg = 0.0
IOB%area_berg = 0.0
IOB%mass_berg = 0.0
IOB%calving = 0.0
IOB%runoff_hflx = 0.0
IOB%calving_hflx = 0.0
IOB%mi = 0.0
IOB%p = 0.0

end subroutine IOB_allocate

Expand Down Expand Up @@ -1044,6 +1062,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
CS%adjust_net_fresh_water_to_zero, &
"If true, adjusts the net fresh-water forcing seen \n"//&
"by the ocean (including restoring) to zero.", default=.false.)
if (CS%adjust_net_fresh_water_to_zero) &
call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", &
CS%use_net_FW_adjustment_sign_bug, &
"If true, use the wrong sign for the adjustment to\n"//&
"the net fresh-water.", default=.false.)
call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", &
CS%adjust_net_fresh_water_by_scaling, &
"If true, adjustments to net fresh water to achieve zero net are\n"//&
Expand Down Expand Up @@ -1308,27 +1331,30 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
outunit = stdout()

write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir)
write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif)
write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir)
write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif)
write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff )
write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
write(outunit,100) 'iobt%seaice_melt_heat', mpp_chksum( iobt%seaice_melt_heat)
write(outunit,100) 'iobt%seaice_melt ', mpp_chksum( iobt%seaice_melt )
write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
write(outunit,100) 'iobt%rofl_flux ', mpp_chksum( iobt%rofl_flux )
write(outunit,100) 'iobt%rofi_flux ', mpp_chksum( iobt%rofi_flux )
write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
write(outunit,100) 'iobt%sw_flux_vis_dir ', mpp_chksum( iobt%sw_flux_vis_dir )
write(outunit,100) 'iobt%sw_flux_vis_dif ', mpp_chksum( iobt%sw_flux_vis_dif )
write(outunit,100) 'iobt%sw_flux_nir_dir ', mpp_chksum( iobt%sw_flux_nir_dir )
write(outunit,100) 'iobt%sw_flux_nir_dif ', mpp_chksum( iobt%sw_flux_nir_dif )
write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
if (associated(iobt%ustar_berg)) &
write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
if (associated(iobt%area_berg)) &
write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
if (associated(iobt%mass_berg)) &
write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
100 FORMAT(" CHECKSUM::",A20," = ",Z20)

call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
Expand Down
Loading

0 comments on commit f9c260d

Please sign in to comment.