Merge pull request #2 from adcroft/new_remapping_algorithm

New remapping algorithm

.travis.yml

@@ -54,11 +54,12 @@ script:
  - (cd MOM6-examples/ocean_only/benchmark && mkdir -p RESTART && mpirun -n 1 ../../../build/ocn/MOM6 1> log)
  - (cd MOM6-examples/ocean_only/circle_obcs && mkdir -p RESTART && mpirun -n 1 ../../../build/symocn/MOM6 1> log)
  - md5sum MOM6-examples/ocean_only/{*,*/*}/ocean.stats > stats.md5
+ - (cd MOM6-examples/ocean_only/unit_tests && mkdir -p RESTART && mpirun -n 1 ../../../build/ocn/MOM6 1> log)
  - (cd MOM6-examples/ocean_only/double_gyre && mkdir -p RESTART && mpirun -n 2 ../../../build/symocn/MOM6 1> log)
- - (cd MOM6-examples/ocean_only/flow_downslope/layer && mkdir -p RESTART && mpirun -n 2 ../../../../build/ocn/MOM6 1>log)
- - (cd MOM6-examples/ocean_only/flow_downslope/rho && mkdir -p RESTART && mpirun -n 2 ../../../../build/ocn/MOM6 1>log)
- - (cd MOM6-examples/ocean_only/flow_downslope/sigma && mkdir -p RESTART && mpirun -n 2 ../../../../build/ocn/MOM6 1>log)
- - (cd MOM6-examples/ocean_only/flow_downslope/z && mkdir -p RESTART && mpirun -n 2 ../../../../build/ocn/MOM6 1>log)
+ - (cd MOM6-examples/ocean_only/flow_downslope/layer && mkdir -p RESTART && mpirun -n 2 ../../../../build/symocn/MOM6 1>log)
+ - (cd MOM6-examples/ocean_only/flow_downslope/rho && mkdir -p RESTART && mpirun -n 2 ../../../../build/symocn/MOM6 1>log)
+ - (cd MOM6-examples/ocean_only/flow_downslope/sigma && mkdir -p RESTART && mpirun -n 2 ../../../../build/symocn/MOM6 1>log)
+ - (cd MOM6-examples/ocean_only/flow_downslope/z && mkdir -p RESTART && mpirun -n 2 ../../../../build/symocn/MOM6 1>log)
  - (cd MOM6-examples/ocean_only/benchmark && mkdir -p RESTART && mpirun -n 4 ../../../build/symocn/MOM6 1> log)
  - (cd MOM6-examples/ocean_only/circle_obcs && mkdir -p RESTART && mpirun -n 4 ../../../build/symocn/MOM6 1> log)
  - md5sum -c stats.md5

src/ALE/MOM_ALE.F90

@@ -95,7 +95,7 @@ module MOM_ALE
   integer, dimension(:), allocatable :: id_Htracer_remap_tendency     !< diagnostic id
   integer, dimension(:), allocatable :: id_Htracer_remap_tendency_2d  !< diagnostic id
   logical, dimension(:), allocatable :: do_tendency_diag              !< flag for doing diagnostics
-  integer                            :: id_dzRegrid
+  integer                            :: id_dzRegrid = -1              !< diagnostic id
 
 end type
 
@@ -669,7 +669,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, dxInt
             ! Build the start and final grids
             h1(:) = h_old(i,j,:)
             h2(:) = h_new(i,j,:)
-            call remapping_core_h( nz, h1, Reg%Tr(m)%t(i,j,:), nz, h2, u_column, CS_remapping )
+            call remapping_core_h(CS_remapping, nz, h1, Reg%Tr(m)%t(i,j,:), nz, h2, u_column)
 
             ! Intermediate steps for tendency of tracer concentration and tracer content.
             ! Note: do not merge the two if-tests, since do_tendency_diag(:) is not
@@ -764,7 +764,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, dxInt
           else
             h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) )
           endif
-          call remapping_core_h( nz, h1, u(I,j,:), nz, h2, u_column, CS_remapping )
+          call remapping_core_h(CS_remapping, nz, h1, u(I,j,:), nz, h2, u_column)
           u(I,j,:) = u_column(:)
         endif
       enddo
@@ -789,7 +789,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, dxInt
           else
             h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) )
           endif
-          call remapping_core_h( nz, h1, v(i,J,:), nz, h2, u_column, CS_remapping )
+          call remapping_core_h(CS_remapping, nz, h1, v(i,J,:), nz, h2, u_column)
           v(i,J,:) = u_column(:)
         endif
       enddo
@@ -849,7 +849,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c
           call dzFromH1H2( n_points, h_src(i,j,1:n_points), GV%ke, h_dst(i,j,:), dx )
           call remapping_core_w(CS, n_points, h_src(i,j,1:n_points), s_src(i,j,1:n_points), GV%ke, dx, s_dst(i,j,:))
         else
-          call remapping_core_h(n_points, h_src(i,j,1:n_points), s_src(i,j,1:n_points), GV%ke, h_dst(i,j,:), s_dst(i,j,:), CS)
+          call remapping_core_h(CS, n_points, h_src(i,j,1:n_points), s_src(i,j,1:n_points), GV%ke, h_dst(i,j,:), s_dst(i,j,:))
         endif
       else
         s_dst(i,j,:) = 0.

src/ALE/coord_rho.F90

@@ -198,10 +198,10 @@ subroutine build_rho_column(CS, remapCS, nz, depth, h, T, S, eqn_of_state, zInte
       h1(k) = x1(k+1) - x1(k)
     end do
 
-    call remapping_core_h(nz, h0, S, nz, h1, Tmp, remapCS)
+    call remapping_core_h(remapCS, nz, h0, S, nz, h1, Tmp)
     S_tmp(:) = Tmp(:)
 
-    call remapping_core_h(nz, h0, T, nz, h1, Tmp, remapCS)
+    call remapping_core_h(remapCS, nz, h0, T, nz, h1, Tmp)
     T_tmp(:) = Tmp(:)
 
     ! Compute the deviation between two successive grids

src/core/MOM.F90

@@ -60,6 +60,7 @@ module MOM
 use MOM_time_manager,         only : time_type, set_time, time_type_to_real, operator(+)
 use MOM_time_manager,         only : operator(-), operator(>), operator(*), operator(/)
 use MOM_time_manager,         only : increment_date
+use MOM_unit_tests,           only : unit_tests
 
 ! MOM core modules
 use MOM_ALE,                   only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity
@@ -1790,6 +1791,13 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mo
                  "\t0 = Only FATAL messages\n" // &
                  "\t2 = Only FATAL, WARNING, NOTE [default]\n" // &
                  "\t9 = All)", default=2)
+  call get_param(param_file, "MOM", "DO_UNIT_TESTS", do_unit_tests, &
+                 "If True, exercises unit tests at model start up.", &
+                 default=.false.)
+  if (do_unit_tests) then
+    call unit_tests(verbosity)
+  endif
+
   call get_param(param_file, "MOM", "SPLIT", CS%split, &
                  "Use the split time stepping if true.", default=.true.)
   if (CS%split) then
@@ -2535,11 +2543,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mo
                 .not.((dirs%input_filename(1:1) == 'r') .and. &
                       (LEN_TRIM(dirs%input_filename) == 1))
 
-  ! Undocumented parameter: set DO_UNIT_TESTS=True to invoke unit_tests s/r
-  ! which calls unit tests provided by some modules.
-  call get_param(param_file, "MOM", "DO_UNIT_TESTS", do_unit_tests, default=.false.)
-  if (do_unit_tests) call unit_tests
-
   call callTree_leave("initialize_MOM()")
   call cpu_clock_end(id_clock_init)
 
@@ -2585,32 +2588,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, fluxes)
 
 end subroutine finish_MOM_initialization
 
-
-!> Calls unit tests for other modules. These are NOT normally invoked
-!! and so we provide the module use statements here rather than in the module
-!! header. This is an exception to our usual coding standards.
-!! Note that if a unit test returns true, a FATAL error is triggered.
-subroutine unit_tests
-  use MOM_string_functions,  only : string_functions_unit_tests
-  use MOM_remapping,         only : remapping_unit_tests
-  use MOM_neutral_diffusion, only : neutral_diffusion_unit_tests
-  use MOM_diag_vkernels,     only : diag_vkernels_unit_tests
-
-  if (is_root_pe()) then ! The following need only be tested on 1 PE
-    if (string_functions_unit_tests()) call MOM_error(FATAL, &
-       "MOM/initialize_MOM/unit_tests: string_functions_unit_tests FAILED")
-    if (remapping_unit_tests()) call MOM_error(FATAL, &
-       "MOM/initialize_MOM/unit_tests: remapping_unit_tests FAILED")
-    if (neutral_diffusion_unit_tests()) call MOM_error(FATAL, &
-       "MOM/initialize_MOM/unit_tests: neutralDiffusionUnitTests FAILED")
-    if (diag_vkernels_unit_tests()) call MOM_error(FATAL, &
-       "MOM/initialize_MOM/unit_tests: diag_vkernels_unit_tests FAILED")
-
-  endif
-
-end subroutine unit_tests
-
-
 !> Register the diagnostics
 subroutine register_diags(Time, G, GV, CS, ADp)
   type(time_type),           intent(in)    :: Time  !< current model time

src/core/MOM_open_boundary.F90

@@ -2179,9 +2179,10 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time)
                 ! Pretty sure we need to check for source/target grid consistency here
                 segment%field(m)%buffer_dst(i,j,:)=0.0  ! initialize remap destination buffer
                 if (G%mask2dT(i,j)>0.) then
-                   call remapping_core_h(segment%field(m)%nk_src,segment%field(m)%dz_src(i,j,:),&
-                        segment%field(m)%buffer_src(i,j,:),G%ke, h(i,j,:),&
-                        segment%field(m)%buffer_dst(i,j,:),OBC%remap_CS)
+                   call remapping_core_h(OBC%remap_CS, &
+                         segment%field(m)%nk_src,segment%field(m)%dz_src(i,j,:), &
+                         segment%field(m)%buffer_src(i,j,:), &
+                         G%ke, h(i,j,:), segment%field(m)%buffer_dst(i,j,:))
                 endif
              enddo
           enddo

src/core/MOM_unit_tests.F90

@@ -0,0 +1,36 @@
+!> Invokes unit tests in all modules that have them
+module MOM_unit_tests
+
+use MOM_error_handler,     only : MOM_error, FATAL, is_root_pe
+
+use MOM_string_functions,  only : string_functions_unit_tests
+use MOM_remapping,         only : remapping_unit_tests
+use MOM_neutral_diffusion, only : neutral_diffusion_unit_tests
+use MOM_diag_vkernels,     only : diag_vkernels_unit_tests
+
+contains
+
+!> Calls unit tests for other modules.
+!! Note that if a unit test returns true, a FATAL error is triggered.
+subroutine unit_tests(verbosity)
+  ! Arguments
+  integer, intent(in) :: verbosity !< The verbosity level
+  ! Local variables
+  logical :: verbose
+
+  verbose = verbosity>=5
+
+  if (is_root_pe()) then ! The following need only be tested on 1 PE
+    if (string_functions_unit_tests(verbose)) call MOM_error(FATAL, &
+       "MOM_unit_tests: string_functions_unit_tests FAILED")
+    if (remapping_unit_tests(verbose)) call MOM_error(FATAL, &
+       "MOM_unit_tests: remapping_unit_tests FAILED")
+    if (neutral_diffusion_unit_tests(verbose)) call MOM_error(FATAL, &
+       "MOM_unit_tests: neutralDiffusionUnitTests FAILED")
+    if (diag_vkernels_unit_tests(verbose)) call MOM_error(FATAL, &
+       "MOM_unit_tests: diag_vkernels_unit_tests FAILED")
+  endif
+
+end subroutine unit_tests
+
+end module MOM_unit_tests

src/diagnostics/MOM_wave_speed.F90

@@ -438,7 +438,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, &
             else
               mode_struct(1:kc)=0.
             endif
-            call remapping_core_h(kc, Hc, mode_struct, nz, h(i,j,:), modal_structure(i,j,:), CS%remapping_CS)
+            call remapping_core_h(CS%remapping_CS, kc, Hc, mode_struct, nz, h(i,j,:), modal_structure(i,j,:))
           endif
         else
           cg1(i,j) = 0.0

src/framework/MOM_diag_remap.F90

@@ -317,9 +317,8 @@ subroutine diag_remap_do_remap(remap_cs, G, h, staggered_in_x, staggered_in_y, &
         endif
         h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:))
         h_dest(:) = 0.5 * (remap_cs%h(i,j,:) + remap_cs%h(i+1,j,:))
-        call remapping_core_h(nz_src, h_src(:), field(I,j,:), &
-                              nz_dest, h_dest(:), remapped_field(I,j,:), &
-                              remap_cs%remap_cs)
+        call remapping_core_h(remap_cs%remap_cs, nz_src, h_src(:), field(I,j,:), &
+                              nz_dest, h_dest(:), remapped_field(I,j,:))
         if (mask_vanished_layers) then ! This only works for z-like output
           do k=1, nz_dest
             if (h_dest(k) == 0.) remapped_field(i, j, k:nz_dest) = missing_value
@@ -336,9 +335,8 @@ subroutine diag_remap_do_remap(remap_cs, G, h, staggered_in_x, staggered_in_y, &
         endif
         h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:))
         h_dest(:) = 0.5 * (remap_cs%h(i,j,:) + remap_cs%h(i,j+1,:) )
-        call remapping_core_h(nz_src, h_src(:), field(i,J,:), &
-                              nz_dest, h_dest(:), remapped_field(i,J,:), &
-                              remap_cs%remap_cs)
+        call remapping_core_h(remap_cs%remap_cs, nz_src, h_src(:), field(i,J,:), &
+                              nz_dest, h_dest(:), remapped_field(i,J,:))
         if (mask_vanished_layers) then ! This only works for z-like output
           do k=1, nz_dest
             if (h_dest(k) == 0.) remapped_field(i,j,k) = missing_value
@@ -354,9 +352,8 @@ subroutine diag_remap_do_remap(remap_cs, G, h, staggered_in_x, staggered_in_y, &
           if (mask(i,j, 1) == 0.) cycle
         endif
         h_dest(:) = remap_cs%h(i,j,:)
-        call remapping_core_h(nz_src, h(i,j,:), field(i,j,:), &
-                              nz_dest, h_dest(:), remapped_field(i,j,:), &
-                              remap_cs%remap_cs)
+        call remapping_core_h(remap_cs%remap_cs, nz_src, h(i,j,:), field(i,j,:), &
+                              nz_dest, h_dest(:), remapped_field(i,j,:))
         if (mask_vanished_layers) then ! This only works for z-like output
           do k=1, nz_dest
             if (h_dest(k)==0.) remapped_field(i,j,k) = missing_value