Merge branch 'dev/gfdl' of github.com:NOAA-GFDL/MOM6 into oda_use_fra…

…mework

.gitlab-ci.yml

@@ -117,8 +117,9 @@ run:
     - time tar zxf $CACHE_DIR/build-pgi-repro-$CI_PIPELINE_ID.tgz
     # time tar zxf $CACHE_DIR/build-gnu-debug-$CI_PIPELINE_ID.tgz
     - (echo '#!/bin/tcsh';echo 'make -f MRS/Makefile.tests all') > job.sh
-    - sbatch --clusters=c3,c4 --nodes=29 --time=0:34:00 --account=gfdl_o --qos=debug --job-name=mom6_regressions --output=log.$CI_PIPELINE_ID --wait job.sh
+    - sbatch --clusters=c3,c4 --nodes=29 --time=0:34:00 --account=gfdl_o --qos=debug --job-name=mom6_regressions --output=log.$CI_PIPELINE_ID --wait job.sh || MJOB_RETURN_STATE=Fail
     - cat log.$CI_PIPELINE_ID
+    - test -z "$MJOB_RETURN_STATE"
     - test -f restart_results_gnu.tar.gz
     - time tar zvcf $CACHE_DIR/results-$CI_PIPELINE_ID.tgz *.tar.gz
 

src/ALE/coord_rho.F90

@@ -97,10 +97,10 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, &
   real, dimension(nz), intent(in)    :: S  !< Salinity for source column [ppt]
   type(EOS_type),      pointer       :: eqn_of_state !< Equation of state structure
   real, dimension(CS%nk+1), &
-       intent(inout) :: z_interface !< Absolute positions of interfaces
-  real, optional,           intent(in)    :: z_rigid_top !< The height of a rigid top (positive upward in the same
+                       intent(inout) :: z_interface !< Absolute positions of interfaces
+  real, optional,      intent(in)    :: z_rigid_top !< The height of a rigid top (positive upward in the same
   !! units as depth) [Z ~> m] or [H ~> m or kg m-2]
-  real, optional,           intent(in)    :: eta_orig !< The actual original height of the top in the same
+  real, optional,      intent(in)    :: eta_orig !< The actual original height of the top in the same
                                                    !! units as depth) [Z ~> m] or [H ~> m or kg m-2]
   real,      optional, intent(in)    :: h_neglect !< A negligibly small width for the purpose
                                              !! of cell reconstructions [H ~> m or kg m-2]
@@ -127,7 +127,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, &
     z0_top = z_rigid_top
     eta=z0_top
     if (present(eta_orig)) then
-       eta=eta_orig
+      eta=eta_orig
     endif
   endif
 

src/core/MOM.F90

@@ -23,8 +23,8 @@ module MOM
 use MOM_diag_mediator,        only : diag_grid_storage, diag_grid_storage_init
 use MOM_diag_mediator,        only : diag_save_grids, diag_restore_grids
 use MOM_diag_mediator,        only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
-use MOM_domains,              only : MOM_domains_init, clone_MOM_domain
-use MOM_domains,              only : sum_across_PEs, pass_var, pass_vector
+use MOM_domain_init,          only : MOM_domains_init
+use MOM_domains,              only : sum_across_PEs, pass_var, pass_vector, clone_MOM_domain
 use MOM_domains,              only : To_North, To_East, To_South, To_West
 use MOM_domains,              only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR
 use MOM_domains,              only : create_group_pass, do_group_pass, group_pass_type
@@ -3280,13 +3280,13 @@ subroutine extract_surface_state(CS, sfc_state_in)
       enddo ; enddo
 
       do i=is,ie
-       ! set melt_potential to zero to avoid passing previous values
-       sfc_state%melt_potential(i,j) = 0.0
+        ! set melt_potential to zero to avoid passing previous values
+        sfc_state%melt_potential(i,j) = 0.0
 
-       if (G%mask2dT(i,j)>0.) then
-         ! instantaneous melt_potential [Q R Z ~> J m-2]
-         sfc_state%melt_potential(i,j) = CS%tv%C_p * GV%Rho0 * delT(i)
-       endif
+        if (G%mask2dT(i,j)>0.) then
+          ! instantaneous melt_potential [Q R Z ~> J m-2]
+          sfc_state%melt_potential(i,j) = CS%tv%C_p * GV%Rho0 * delT(i)
+        endif
       enddo
     enddo ! end of j loop
   endif   ! melt_potential

src/core/MOM_dynamics_split_RK2.F90

@@ -16,7 +16,6 @@ module MOM_dynamics_split_RK2
 use MOM_diag_mediator,     only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator,     only : register_diag_field, register_static_field
 use MOM_diag_mediator,     only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids
-use MOM_domains,           only : MOM_domains_init
 use MOM_domains,           only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_domains,           only : To_North, To_East, Omit_Corners
 use MOM_domains,           only : create_group_pass, do_group_pass, group_pass_type
@@ -1265,7 +1264,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
       do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo
     endif
     do k=1,nz ; do j=js,je ; do i=is,ie
-       CS%eta(i,j) = CS%eta(i,j) + h(i,j,k)
+      CS%eta(i,j) = CS%eta(i,j) + h(i,j,k)
     enddo ; enddo ; enddo
   elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then
     H_rescale = GV%m_to_H / GV%m_to_H_restart

src/core/MOM_dynamics_unsplit.F90

@@ -61,9 +61,8 @@ module MOM_dynamics_unsplit
 use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator, only : register_diag_field, register_static_field
 use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids
-use MOM_domains, only : MOM_domains_init, pass_var, pass_vector
-use MOM_domains, only : pass_var_start, pass_var_complete
-use MOM_domains, only : pass_vector_start, pass_vector_complete
+use MOM_domains, only : pass_var, pass_var_start, pass_var_complete
+use MOM_domains, only : pass_vector, pass_vector_start, pass_vector_complete
 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
 use MOM_file_parser, only : get_param, log_version, param_file_type

src/core/MOM_dynamics_unsplit_RK2.F90

@@ -59,9 +59,8 @@ module MOM_dynamics_unsplit_RK2
 use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator, only : register_diag_field, register_static_field
 use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl
-use MOM_domains, only : MOM_domains_init, pass_var, pass_vector
-use MOM_domains, only : pass_var_start, pass_var_complete
-use MOM_domains, only : pass_vector_start, pass_vector_complete
+use MOM_domains, only : pass_var, pass_var_start, pass_var_complete
+use MOM_domains, only : pass_vector, pass_vector_start, pass_vector_complete
 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
 use MOM_error_handler, only : MOM_set_verbosity

src/core/MOM_grid.F90

@@ -5,7 +5,7 @@ module MOM_grid
 
 use MOM_hor_index, only : hor_index_type, hor_index_init
 use MOM_domains, only : MOM_domain_type, get_domain_extent, compute_block_extent
-use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2
+use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2, deallocate_MOM_domain
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL
 use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
 use MOM_unit_scaling, only : unit_scale_type
@@ -630,8 +630,9 @@ subroutine MOM_grid_end(G)
   deallocate(G%gridLonT) ; deallocate(G%gridLatT)
   deallocate(G%gridLonB) ; deallocate(G%gridLatB)
 
-  deallocate(G%Domain%mpp_domain)
-  deallocate(G%Domain)
+  ! The cursory flag avoids doing any deallocation of memory in the underlying
+  ! infrastructure to avoid problems due to shared pointers.
+  call deallocate_MOM_domain(G%Domain, cursory=.true.)
 
 end subroutine MOM_grid_end
 

src/core/MOM_open_boundary.F90

@@ -4958,16 +4958,16 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart
   type(OBC_segment_type), pointer :: segment=>NULL()
 
   if (.not. associated(OBC)) &
-       call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//&
+    call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//&
                       "uninitialized OBC control structure")
 
   if (associated(OBC%rx_normal) .or. associated(OBC%ry_normal) .or. &
       associated(OBC%rx_oblique) .or. associated(OBC%ry_oblique) .or. associated(OBC%cff_normal)) &
-       call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//&
+    call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//&
                       "arrays were previously allocated")
 
   if (associated(OBC%tres_x) .or. associated(OBC%tres_y)) &
-       call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//&
+    call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//&
                       "arrays were previously allocated")
 
   ! *** This is a temporary work around for restarts with OBC segments.
@@ -5188,36 +5188,36 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld)
     ! previous call to open_boundary_impose_normal_slope
     do k=nz+1,1,-1
       if (-eta(i,j,k) > segment%Htot(i,j)*GV%H_to_Z + hTolerance) then
-         eta(i,j,k) = -segment%Htot(i,j)*GV%H_to_Z
-         contractions = contractions + 1
+        eta(i,j,k) = -segment%Htot(i,j)*GV%H_to_Z
+        contractions = contractions + 1
       endif
     enddo
 
     do k=1,nz
       ! Collapse layers to thinnest possible if the thickness less than
       ! the thinnest possible (or negative).
       if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then
-         eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
-         segment%field(fld)%dz_src(i,j,k) = GV%Angstrom_Z
+        eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z
+        segment%field(fld)%dz_src(i,j,k) = GV%Angstrom_Z
       else
-         segment%field(fld)%dz_src(i,j,k) = (eta(i,j,K) - eta(i,j,K+1))
+        segment%field(fld)%dz_src(i,j,k) = (eta(i,j,K) - eta(i,j,K+1))
       endif
     enddo
 
     !   The whole column is dilated to accommodate deeper topography than
     ! the bathymetry would indicate.
     if (-eta(i,j,nz+1) < (segment%Htot(i,j) * GV%H_to_Z) - hTolerance) then
-       dilations = dilations + 1
-       ! expand bottom-most cell only
-       eta(i,j,nz+1) = -(segment%Htot(i,j) * GV%H_to_Z)
-       segment%field(fld)%dz_src(i,j,nz)= eta(i,j,nz)-eta(i,j,nz+1)
-       ! if (eta(i,j,1) <= eta(i,j,nz+1)) then
-       !   do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo
-       ! else
-       !   dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1))
-       !   do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo
-       ! endif
-       !do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo
+      dilations = dilations + 1
+      ! expand bottom-most cell only
+      eta(i,j,nz+1) = -(segment%Htot(i,j) * GV%H_to_Z)
+      segment%field(fld)%dz_src(i,j,nz)= eta(i,j,nz)-eta(i,j,nz+1)
+      ! if (eta(i,j,1) <= eta(i,j,nz+1)) then
+      !   do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo
+      ! else
+      !   dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1))
+      !   do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo
+      ! endif
+      !do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo
     endif
     ! Now convert thicknesses to units of H.
     do k=1,nz
@@ -5241,8 +5241,6 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld)
   ! endif
   deallocate(eta)
 
-
-
 end subroutine adjustSegmentEtaToFitBathymetry
 
 !> This is more of a rotate initialization than an actual rotate

src/diagnostics/MOM_diagnostics.F90

@@ -501,7 +501,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
   ! area mean SST
   if (CS%id_tosga > 0) then
     do j=js,je ; do i=is,ie
-       surface_field(i,j) = tv%T(i,j,1)
+      surface_field(i,j) = tv%T(i,j,1)
     enddo ; enddo
     tosga = global_area_mean(surface_field, G)
     call post_data(CS%id_tosga, tosga, CS%diag)
@@ -1024,9 +1024,9 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
 
   if (.not.G%symmetric) then
     if (associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_BT) .OR. &
-       associated(CS%KE_CorAdv) .OR. associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. &
-       associated(CS%KE_horvisc) .OR. associated(CS%KE_dia) ) then
-        call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East)
+        associated(CS%KE_CorAdv) .OR. associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. &
+        associated(CS%KE_horvisc) .OR. associated(CS%KE_dia) ) then
+      call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East)
     endif
   endif
 

src/diagnostics/MOM_sum_output.F90

@@ -4,7 +4,7 @@ module MOM_sum_output
 ! This file is part of MOM6. See LICENSE.md for the license.
 
 use iso_fortran_env, only : int64
-use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs
+use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum
 use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP
 use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs
 use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg
@@ -25,7 +25,6 @@ module MOM_sum_output
 use MOM_unit_scaling, only : unit_scale_type
 use MOM_variables, only : surface, thermo_var_ptrs
 use MOM_verticalGrid, only : verticalGrid_type
-use mpp_mod, only : mpp_chksum
 
 use netcdf
 
@@ -1022,8 +1021,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS)
     enddo ; enddo ; endif
 
     if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie
-       heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * &
-                                     fluxes%seaice_melt_heat(i,j)
+      heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * &
+                                    fluxes%seaice_melt_heat(i,j)
     enddo ; enddo ; endif
 
     ! smg: new code
@@ -1511,13 +1510,13 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum)
   do j=G%jsc,G%jec ; do i=G%isc,G%iec
     field(i,j) = G%bathyT(i,j)
   enddo ; enddo
-  write(depth_chksum, '(Z16)') mpp_chksum(field(:,:))
+  write(depth_chksum, '(Z16)') field_chksum(field(:,:))
 
   ! Area checksum
   do j=G%jsc,G%jec ; do i=G%isc,G%iec
     field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j)
   enddo ; enddo
-  write(area_chksum, '(Z16)') mpp_chksum(field(:,:))
+  write(area_chksum, '(Z16)') field_chksum(field(:,:))
 
   deallocate(field)
 end subroutine get_depth_list_checksums