Add new way of calculating latent heat

NOAA-GFDL · Feb 20, 2019 · 1241da8 · 1241da8
1 parent a68376b
commit 1241da8
Showing 1 changed file with 29 additions and 12 deletions.
diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90
@@ -203,8 +203,8 @@ module MOM_surface_forcing
 !! See \ref section_ocn_import for a summary of the surface fluxes that are
 !! passed from MCT to MOM6, including fluxes that need to be included in
 !! the future.
-subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
-                                 sfc_state, restore_salt, restore_temp)
+subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, sfc_state, &
+                                 restore_salt, restore_temp)
 
   type(ice_ocean_boundary_type), &
                  target, intent(in)    :: IOB    !< An ice-ocean boundary type with fluxes to drive
@@ -213,7 +213,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
   type(forcing),           intent(inout) :: fluxes !< A structure containing pointers to
                                                    !! all possible mass, heat or salt flux forcing fields.
                                                    !!  Unused fields have NULL ptrs.
-
   type(time_type),         intent(in)    :: Time   !< The time of the fluxes, used for interpolating the
                                                    !! salinity to the right time, when it is being restored.
   type(ocean_grid_type),   intent(inout) :: G      !< The ocean's grid structure
@@ -241,7 +240,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
 
   integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0
   integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer
-  integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
 
   logical :: restore_salinity ! local copy of the argument restore_salt, if it
                               ! is present, or false (no restoring) otherwise.
@@ -392,9 +390,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
     enddo; enddo
   endif
 
-  !i0 = is - isc_bnd ; j0 = js - jsc_bnd ???
-  i0 = 0; j0 = 0 ! TODO: is this right?
-
+  ! obtain fluxes from IOB
+  i0 = 0; j0 = 0
   do j=js,je ; do i=is,ie
     ! liquid precipitation (rain)
     if (associated(fluxes%lprec)) &
@@ -453,8 +450,27 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, &
       fluxes%meltw(i,j) = G%mask2dT(i,j) * IOB%meltw(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)
+    ! old method, latent = IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
+    !if (associated(fluxes%latent)) &
+    !  fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0)
+    ! new method
+    fluxes%latent(i,j) = 0.0
+    ! contribution from frozen ppt
+    if (associated(fluxes%fprec)) then
+      fluxes%latent(i,j)              = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
+      fluxes%latent_fprec_diag(i,j)   = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
+    endif
+    ! contribution from frozen runoff
+    if (associated(fluxes%frunoff)) then
+      fluxes%latent(i,j)              = fluxes%latent(i,j) + IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion
+      fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion
+    endif
+    ! contribution from evaporation
+    if (associated(IOB%q_flux)) then
+      fluxes%latent(i,j)             = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
+      fluxes%latent_evap_diag(i,j)  = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
+    endif
+    fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j)
 
     if (associated(IOB%sw_flux_vis_dir)) &
       fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0)
@@ -574,10 +590,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS)
   IsdB = G%IsdB  ; IedB = G%IedB   ; JsdB = G%JsdB  ; JedB = G%JedB
   isr = is-isd+1 ; ier  = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1
 
- !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2)
- !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4)
+ isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2)
+ jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4)
+ !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd
  !i0 = is - isc_bnd ; j0 = js - jsc_bnd
-  i0 = 0; j0 = 0 ! TODO: is this right?
+ i0 = 0; j0 = 0 ! TODO: is this right?
 
   Irho0 = 1.0/CS%Rho0