Skip to content

Commit

Permalink
Merge remote-tracking branch 'gfdl/dev/gfdl' into esmg_work
Browse files Browse the repository at this point in the history
  • Loading branch information
kshedstrom committed Oct 16, 2024
2 parents e65fd22 + 80d8b5f commit b3aee99
Show file tree
Hide file tree
Showing 12 changed files with 913 additions and 284 deletions.
2 changes: 1 addition & 1 deletion .testing/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -282,7 +282,7 @@ $(BUILD)/%/MOM6: $(BUILD)/%/Makefile FORCE

# Target codebase should use its own build system
$(BUILD)/target/MOM6: $(BUILD)/target FORCE | $(TARGET_CODEBASE)
$(MAKE) -C $(TARGET_CODEBASE)/.testing build/symmetric/MOM6
$(MAKE) -C $(TARGET_CODEBASE)/.testing BUILD=build build/symmetric/MOM6

$(BUILD)/target: | $(TARGET_CODEBASE)
ln -s $(abspath $(TARGET_CODEBASE))/.testing/build/symmetric $@
Expand Down
5 changes: 5 additions & 0 deletions config_src/drivers/nuopc_cap/mom_cap.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2371,6 +2371,11 @@ subroutine SetScalarField(field, rc)
ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! initialize fldptr to zero
call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
fldptr2d(:,:) = 0.0

end subroutine SetScalarField

end subroutine MOM_RealizeFields
Expand Down
12 changes: 6 additions & 6 deletions src/core/MOM.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2706,7 +2706,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
CS%tv%T => CS%T ; CS%tv%S => CS%S
if (CS%tv%T_is_conT) then
vd_T = var_desc(name="contemp", units="Celsius", longname="Conservative Temperature", &
cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", &
cmor_field_name="bigthetao", cmor_longname="Sea Water Conservative Temperature", &
conversion=US%Q_to_J_kg*CS%tv%C_p)
else
vd_T = var_desc(name="temp", units="degC", longname="Potential Temperature", &
Expand All @@ -2715,7 +2715,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
endif
if (CS%tv%S_is_absS) then
vd_S = var_desc(name="abssalt", units="g kg-1", longname="Absolute Salinity", &
cmor_field_name="so", cmor_longname="Sea Water Salinity", &
cmor_field_name="absso", cmor_longname="Sea Water Absolute Salinity", &
conversion=0.001*US%S_to_ppt)
else
vd_S = var_desc(name="salt", units="psu", longname="Salinity", &
Expand Down Expand Up @@ -2799,10 +2799,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0

!allocate porous topography variables
allocate(CS%pbv%por_face_areaU(IsdB:IedB,jsd:jed,nz)) ; CS%pbv%por_face_areaU(:,:,:) = 1.0
allocate(CS%pbv%por_face_areaV(isd:ied,JsdB:JedB,nz)) ; CS%pbv%por_face_areaV(:,:,:) = 1.0
allocate(CS%pbv%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1)) ; CS%pbv%por_layer_widthU(:,:,:) = 1.0
allocate(CS%pbv%por_layer_widthV(isd:ied,JsdB:JedB,nz+1)) ; CS%pbv%por_layer_widthV(:,:,:) = 1.0
allocate(CS%pbv%por_face_areaU(IsdB:IedB,jsd:jed,nz), source=1.0)
allocate(CS%pbv%por_face_areaV(isd:ied,JsdB:JedB,nz), source=1.0)
allocate(CS%pbv%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1), source=1.0)
allocate(CS%pbv%por_layer_widthV(isd:ied,JsdB:JedB,nz+1), source=1.0)

! Use the Wright equation of state by default, unless otherwise specified
! Note: this line and the following block ought to be in a separate
Expand Down
64 changes: 40 additions & 24 deletions src/core/MOM_porous_barriers.F90
Original file line number Diff line number Diff line change
Expand Up @@ -122,16 +122,20 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
A_layer_prev(I,j) = A_layer
endif ; enddo ; enddo ; enddo
else
do k=nk,1,-1 ; do j=js,je ; do I=Isq,Ieq ; if (do_I(I,j)) then
call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), &
eta_u(I,j,K), A_layer, do_I(I,j))
if (eta_u(I,j,K) - (eta_u(I,j,K+1)+dz_min) > 0.0) then
pbv%por_face_areaU(I,j,k) = min(1.0, (A_layer - A_layer_prev(I,j)) / (eta_u(I,j,K) - eta_u(I,j,K+1)))
do k=nk,1,-1 ; do j=js,je ; do I=Isq,Ieq
if (do_I(I,j)) then
call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), &
eta_u(I,j,K), A_layer, do_I(I,j))
if (eta_u(I,j,K) - (eta_u(I,j,K+1)+dz_min) > 0.0) then
pbv%por_face_areaU(I,j,k) = min(1.0, (A_layer - A_layer_prev(I,j)) / (eta_u(I,j,K) - eta_u(I,j,K+1)))
else
pbv%por_face_areaU(I,j,k) = 0.0 ! use calc_por_interface() might be a better choice
endif
A_layer_prev(I,j) = A_layer
else
pbv%por_face_areaU(I,j,k) = 0.0 ! use calc_por_interface() might be a better choice
pbv%por_face_areaU(I,j,k) = 1.0
endif
A_layer_prev(I,j) = A_layer
endif ; enddo ; enddo ; enddo
enddo ; enddo ; enddo
endif

! v-points
Expand All @@ -154,16 +158,20 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
A_layer_prev(i,J) = A_layer
endif ; enddo ; enddo ; enddo
else
do k=nk,1,-1 ; do J=Jsq,Jeq ; do i=is,ie ; if (do_I(i,J)) then
call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), &
eta_v(i,J,K), A_layer, do_I(i,J))
if (eta_v(i,J,K) - (eta_v(i,J,K+1)+dz_min) > 0.0) then
pbv%por_face_areaV(i,J,k) = min(1.0, (A_layer - A_layer_prev(i,J)) / (eta_v(i,J,K) - eta_v(i,J,K+1)))
do k=nk,1,-1 ; do J=Jsq,Jeq ; do i=is,ie
if (do_I(i,J)) then
call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), &
eta_v(i,J,K), A_layer, do_I(i,J))
if (eta_v(i,J,K) - (eta_v(i,J,K+1)+dz_min) > 0.0) then
pbv%por_face_areaV(i,J,k) = min(1.0, (A_layer - A_layer_prev(i,J)) / (eta_v(i,J,K) - eta_v(i,J,K+1)))
else
pbv%por_face_areaV(i,J,k) = 0.0 ! use calc_por_interface() might be a better choice
endif
A_layer_prev(i,J) = A_layer
else
pbv%por_face_areaV(i,J,k) = 0.0 ! use calc_por_interface() might be a better choice
pbv%por_face_areaV(i,J,k) = 1.0
endif
A_layer_prev(i,J) = A_layer
endif ; enddo ; enddo ; enddo
enddo ; enddo ; enddo
endif

if (CS%debug) then
Expand Down Expand Up @@ -231,10 +239,14 @@ subroutine porous_widths_interface(h, tv, G, GV, US, pbv, CS, eta_bt)
eta_u(I,j,K), pbv%por_layer_widthU(I,j,K), do_I(I,j))
endif ; enddo ; enddo ; enddo
else
do K=1,nk+1 ; do j=js,je ; do I=Isq,Ieq ; if (do_I(I,j)) then
call calc_por_interface(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), &
eta_u(I,j,K), pbv%por_layer_widthU(I,j,K), do_I(I,j))
endif ; enddo ; enddo ; enddo
do K=1,nk+1 ; do j=js,je ; do I=Isq,Ieq
if (do_I(I,j)) then
call calc_por_interface(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), &
eta_u(I,j,K), pbv%por_layer_widthU(I,j,K), do_I(I,j))
else
pbv%por_layer_widthU(I,j,K) = 1.0
endif
enddo ; enddo ; enddo
endif

! v-points
Expand All @@ -249,10 +261,14 @@ subroutine porous_widths_interface(h, tv, G, GV, US, pbv, CS, eta_bt)
eta_v(i,J,K), pbv%por_layer_widthV(i,J,K), do_I(i,J))
endif ; enddo ; enddo ; enddo
else
do K=1,nk+1 ; do J=Jsq,Jeq ; do i=is,ie ; if (do_I(i,J)) then
call calc_por_interface(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), &
eta_v(i,J,K), pbv%por_layer_widthV(i,J,K), do_I(i,J))
endif ; enddo ; enddo ; enddo
do K=1,nk+1 ; do J=Jsq,Jeq ; do i=is,ie
if (do_I(i,J)) then
call calc_por_interface(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), &
eta_v(i,J,K), pbv%por_layer_widthV(i,J,K), do_I(i,J))
else
pbv%por_layer_widthV(i,J,K) = 1.0
endif
enddo ; enddo ; enddo
endif

if (CS%debug) then
Expand Down
1 change: 0 additions & 1 deletion src/core/MOM_variables.F90
Original file line number Diff line number Diff line change
Expand Up @@ -323,7 +323,6 @@ module MOM_variables
end type BT_cont_type

!> Container for grids modifying cell metric at porous barriers
! TODO: rename porous_barrier_type to porous_barrier_type
type, public :: porous_barrier_type
! Each of the following fields has nz layers.
real, allocatable :: por_face_areaU(:,:,:) !< fractional open area of U-faces [nondim]
Expand Down
24 changes: 15 additions & 9 deletions src/ice_shelf/MOM_ice_shelf.F90
Original file line number Diff line number Diff line change
Expand Up @@ -450,11 +450,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
I_au = 0.0 ; if (asu1 + asu2 > 0.0) I_au = 1.0 / (asu1 + asu2)
I_av = 0.0 ; if (asv1 + asv2 > 0.0) I_av = 1.0 / (asv1 + asv2)
if (allocated(sfc_state%taux_shelf) .and. allocated(sfc_state%tauy_shelf)) then
taux2 = (asu1 * sfc_state%taux_shelf(I-1,j)**2 + asu2 * sfc_state%taux_shelf(I,j)**2 ) * I_au
tauy2 = (asv1 * sfc_state%tauy_shelf(i,J-1)**2 + asv2 * sfc_state%tauy_shelf(i,J)**2 ) * I_av
taux2 = (((asu1 * (sfc_state%taux_shelf(I-1,j)**2)) + (asu2 * (sfc_state%taux_shelf(I,j)**2)) ) * I_au)
tauy2 = (((asv1 * (sfc_state%tauy_shelf(i,J-1)**2)) + (asv2 * (sfc_state%tauy_shelf(i,J)**2)) ) * I_av)
endif
u2_av = (asu1 * sfc_state%u(I-1,j)**2 + asu2 * sfc_state%u(I,j)**2) * I_au
v2_av = (asv1 * sfc_state%v(i,J-1)**2 + asu2 * sfc_state%v(i,J)**2) * I_av
u2_av = (((asu1 * (sfc_state%u(I-1,j)**2)) + (asu2 * sfc_state%u(I,j)**2)) * I_au)
v2_av = (((asv1 * (sfc_state%v(i,J-1)**2)) + (asu2 * sfc_state%v(i,J)**2)) * I_av)

if ((taux2 + tauy2 > 0.0) .and. .not.CS%ustar_shelf_from_vel) then
if (CS%ustar_max >= 0.0) then
Expand Down Expand Up @@ -824,7 +824,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
ISS%dhdt_shelf(i,j) = (ISS%h_shelf(i,j) - ISS%dhdt_shelf(i,j))*Itime_step
enddo; enddo

call IS_dynamics_post_data(time_step, Time, CS%dCS, G)
call IS_dynamics_post_data(time_step, Time, CS%dCS, ISS, G)
endif

if (CS%shelf_mass_is_dynamic) &
Expand Down Expand Up @@ -2603,7 +2603,7 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in
call process_and_post_scalar_data(CS, vaf0, vaf0_A, vaf0_G, Ifull_time_step, dh_adott, dh_adott*0.0)
call disable_averaging(CS%diag)

call IS_dynamics_post_data(full_time_step, Time, CS%dCS, G)
call IS_dynamics_post_data(full_time_step, Time, CS%dCS, ISS, G)
end subroutine solo_step_ice_shelf

!> Post_data calls for ice-sheet scalars
Expand Down Expand Up @@ -2648,7 +2648,9 @@ subroutine process_and_post_scalar_data(CS, vaf0, vaf0_A, vaf0_G, Itime_step, dh
endif
if (CS%id_f_adott > 0 .or. CS%id_f_adot > 0) then !floating only: surface accumulation - surface melt
call masked_var_grounded(G,CS%dCS,dh_adott,tmp)
tmp(:,:) = dh_adott(:,:) - tmp(:,:)
do j=js,je ; do i=is,ie
tmp(i,j) = dh_adott(i,j) - tmp(i,j)
enddo; enddo
call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val)
if (CS%id_f_adott > 0) call post_scalar_data(CS%id_f_adott,val ,CS%diag)
if (CS%id_f_adot > 0) call post_scalar_data(CS%id_f_adot ,val*Itime_step,CS%diag)
Expand Down Expand Up @@ -2710,7 +2712,9 @@ subroutine process_and_post_scalar_data(CS, vaf0, vaf0_A, vaf0_G, Itime_step, dh
endif
if (CS%id_Ant_f_adott > 0 .or. CS%id_Ant_f_adot > 0) then !floating only: surface accumulation - surface melt
call masked_var_grounded(G,CS%dCS,dh_adott,tmp)
tmp(:,:) = dh_adott(:,:) - tmp(:,:)
do j=js,je ; do i=is,ie
tmp(i,j) = dh_adott(i,j) - tmp(i,j)
enddo; enddo
call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val, hemisphere=0)
if (CS%id_Ant_f_adott > 0) call post_scalar_data(CS%id_Ant_f_adott,val ,CS%diag)
if (CS%id_Ant_f_adot > 0) call post_scalar_data(CS%id_Ant_f_adot ,val*Itime_step,CS%diag)
Expand Down Expand Up @@ -2772,7 +2776,9 @@ subroutine process_and_post_scalar_data(CS, vaf0, vaf0_A, vaf0_G, Itime_step, dh
endif
if (CS%id_Gr_f_adott > 0 .or. CS%id_Gr_f_adot > 0) then !floating only: surface accumulation - surface melt
call masked_var_grounded(G,CS%dCS,dh_adott,tmp)
tmp(:,:) = dh_adott(:,:) - tmp(:,:)
do j=js,je ; do i=is,ie
tmp(i,j) = dh_adott(i,j) - tmp(i,j)
enddo; enddo
call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val, hemisphere=1)
if (CS%id_Gr_f_adott > 0) call post_scalar_data(CS%id_Gr_f_adott,val ,CS%diag)
if (CS%id_Gr_f_adot > 0) call post_scalar_data(CS%id_Gr_f_adot ,val*Itime_step,CS%diag)
Expand Down
Loading

0 comments on commit b3aee99

Please sign in to comment.