Merge pull request #10 from NOAA-GFDL/dev/gfdl

Merge in latest commits

config_src/coupled_driver/ocean_model_MOM.F90

@@ -442,8 +442,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
   real,    optional, intent(in)    :: cycle_length !< The duration of a coupled time stepping cycle [s].
 
   ! Local variables
-  type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow
-                            ! step_MOM to temporarily change the time as seen by internal modules.
+  type(time_type) :: Time_seg_start ! Stores the dynamic or thermodynamic ocean model time at the
+                            ! start of this call to allow step_MOM to temporarily change the time
+                            ! as seen by internal modules.
+  type(time_type) :: Time_thermo_start ! Stores the ocean model thermodynamics time at the start of
+                            ! this call to allow step_MOM to temporarily change the time as seen by
+                            ! internal modules.
   type(time_type) :: Time1  ! The value of the ocean model's time at the start of a call to step_MOM.
   integer :: index_bnds(4)  ! The computational domain index bounds in the ice-ocean boundary type.
   real :: weight            ! Flux accumulation weight of the current fluxes.
@@ -563,6 +567,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
     call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
   endif
 
+  Time_thermo_start = OS%Time
   Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn
   Time1 = Time_seg_start
 
@@ -576,7 +581,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
                   reset_therm=Ocn_fluxes_used)
   elseif (OS%single_step_call) then
     call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves)
-  else
+  else  ! Step both the dynamics and thermodynamics with separate calls.
     n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001)
     dt_dyn = dt_coupling / real(n_max)
     thermo_does_span_coupling = (OS%thermo_spans_coupling .and. (OS%dt_therm > 1.5*dt_coupling))
@@ -636,7 +641,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
 
   if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step
   if (do_dyn) OS%nstep = OS%nstep + 1
-  OS%Time = Time_seg_start  ! Reset the clock to compensate for shared pointers.
+  OS%Time = Time_thermo_start  ! Reset the clock to compensate for shared pointers.
   if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step
   if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1
 

src/core/MOM.F90

@@ -734,8 +734,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
 
     !===========================================================================
     ! This is the second place where the diabatic processes and remapping could occur.
-    if (CS%t_dyn_rel_adv == 0.0 .and. do_thermo .and. .not.CS%diabatic_first) then
+    if ((CS%t_dyn_rel_adv==0.0) .and. do_thermo .and. (.not.CS%diabatic_first)) then
+
       dtdia = CS%t_dyn_rel_thermo
+      ! If the MOM6 dynamic and thermodynamic time stepping is being orchestrated
+      ! by the coupler, the value of diabatic_first does not matter.
+      if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) dtdia = dt
+
       if (CS%thermo_spans_coupling .and. (CS%dt_therm > 1.5*cycle_time) .and. &
           (abs(dt_therm - dtdia) > 1e-6*dt_therm)) then
         call MOM_error(FATAL, "step_MOM: Mismatch between dt_therm and dtdia "//&
@@ -750,7 +755,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, &
       call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, &
                            Time_local, .false., Waves=Waves)
       CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia
-      CS%t_dyn_rel_thermo = 0.0
+
+      if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then
+        ! The diabatic processes are now ahead of the dynamics by dtdia.
+        CS%t_dyn_rel_thermo = -dtdia
+      else ! The diabatic processes and the dynamics are synchronized.
+        CS%t_dyn_rel_thermo = 0.0
+      endif
 
       if (dtdia > dt) & ! Reset CS%Time to its previous value.
         CS%Time = Time_start + real_to_time(rel_time - 0.5*dt)

src/framework/MOM_safe_alloc.F90

@@ -10,13 +10,14 @@ module MOM_safe_alloc
 
 !> Allocate a pointer to a 1-d, 2-d or 3-d array
 interface safe_alloc_ptr
-  module procedure safe_alloc_ptr_3d_2arg, safe_alloc_ptr_2d_2arg
+  module procedure safe_alloc_ptr_3d_3arg,  safe_alloc_ptr_3d_6arg, safe_alloc_ptr_2d_2arg
   module procedure safe_alloc_ptr_3d, safe_alloc_ptr_2d, safe_alloc_ptr_1d
 end interface safe_alloc_ptr
 
 !> Allocate a 2-d or 3-d allocatable array
 interface safe_alloc_alloc
   module procedure safe_alloc_allocatable_3d, safe_alloc_allocatable_2d
+  module procedure safe_alloc_allocatable_3d_6arg
 end interface safe_alloc_alloc
 
 !   This combined interface might work with a later version of Fortran, but
@@ -57,7 +58,7 @@ subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj)
 end subroutine safe_alloc_ptr_2d_2arg
 
 !> Allocate a pointer to a 3-d array based on its dimension sizes
-subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk)
+subroutine safe_alloc_ptr_3d_3arg(ptr, ni, nj, nk)
   real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate
   integer, intent(in) :: ni !< The size of the 1st dimension of the array
   integer, intent(in) :: nj !< The size of the 2nd dimension of the array
@@ -66,7 +67,7 @@ subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk)
     allocate(ptr(ni,nj,nk))
     ptr(:,:,:) = 0.0
   endif
-end subroutine safe_alloc_ptr_3d_2arg
+end subroutine safe_alloc_ptr_3d_3arg
 
 !> Allocate a pointer to a 2-d array based on its index starting and ending values
 subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je)
@@ -95,6 +96,22 @@ subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk)
   endif
 end subroutine safe_alloc_ptr_3d
 
+!> Allocate a pointer to a 3-d array based on its index starting and ending values
+subroutine safe_alloc_ptr_3d_6arg(ptr, is, ie, js, je, ks, ke)
+  real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate
+  integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+  integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+  integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+  integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
+  integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension
+  integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension
+  if (.not.associated(ptr)) then
+    allocate(ptr(is:ie,js:je,ks:ke))
+    ptr(:,:,:) = 0.0
+  endif
+end subroutine safe_alloc_ptr_3d_6arg
+
+
 !> Allocate a 2-d allocatable array based on its index starting and ending values
 subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je)
   real, dimension(:,:), allocatable :: ptr !< An allocatable array to allocate
@@ -109,6 +126,7 @@ subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je)
 end subroutine safe_alloc_allocatable_2d
 
 !> Allocate a 3-d allocatable array based on its index starting and ending values
+!! and k-index size
 subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk)
   real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate
   integer, intent(in) :: is !< The start index to allocate for the 1st dimension
@@ -122,4 +140,19 @@ subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk)
   endif
 end subroutine safe_alloc_allocatable_3d
 
+!> Allocate a 3-d allocatable array based on its 6 index starting and ending values
+subroutine safe_alloc_allocatable_3d_6arg(ptr, is, ie, js, je, ks, ke)
+  real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate
+  integer, intent(in) :: is !< The start index to allocate for the 1st dimension
+  integer, intent(in) :: ie !< The end index to allocate for the 1st dimension
+  integer, intent(in) :: js !< The start index to allocate for the 2nd dimension
+  integer, intent(in) :: je !< The end index to allocate for the 2nd dimension
+  integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension
+  integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension
+  if (.not.allocated(ptr)) then
+    allocate(ptr(is:ie,js:je,ks:ke))
+    ptr(:,:,:) = 0.0
+  endif
+end subroutine safe_alloc_allocatable_3d_6arg
+
 end module MOM_safe_alloc

src/parameterizations/vertical/MOM_diabatic_driver.F90

@@ -422,6 +422,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
   eaml => eatr ; ebml => ebtr
 
   ! inverse time step
+  if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
+        "diabatic was called with a zero length timestep.")
+  if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
+        "diabatic was called with a negative timestep.")
   Idt = 1.0 / dt
 
   if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
@@ -1301,6 +1305,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
   eaml => eatr ; ebml => ebtr
 
   ! inverse time step
+  if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
+        "legacy_diabatic was called with a zero length timestep.")
+  if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
+        "legacy_diabatic was called with a negative timestep.")
   Idt = 1.0 / dt
 
   if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// &
@@ -2506,7 +2514,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV,
   integer :: i, j, k, is, ie, js, je, nz
 
   is  = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
-  Idt = 1/dt
+  Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt
   work_3d(:,:,:) = 0.0
   work_2d(:,:)   = 0.0
 
@@ -2596,7 +2604,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old,
   integer :: i, j, k, is, ie, js, je, nz
 
   is  = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
-  Idt = 1/dt
+  Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt
   work_3d(:,:,:) = 0.0
   work_2d(:,:)   = 0.0
 
@@ -2683,7 +2691,7 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS)
   integer :: i, j, k, is, ie, js, je, nz
 
   is  = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke
-  Idt = 1/dt
+  Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt
 
   ! temperature tendency
   if (CS%id_frazil_temp_tend > 0) then

src/parameterizations/vertical/MOM_vert_friction.F90

@@ -669,7 +669,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC)
     allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0
   endif
 
-  !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, &
+  !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, &
   !$OMP                                     OBC,h_neglect,dt,I_valBL,Kv_u) &
   !$OMP                     firstprivate(i_hbbl)
   do j=G%Jsc,G%Jec
@@ -836,7 +836,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC)
 
 
   ! Now work on v-points.
-  !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, &
+  !$OMP parallel do default(private) shared(G,GV,CS,US,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, &
   !$OMP                                  OBC,h_neglect,dt,I_valBL,Kv_v) &
   !$OMP                     firstprivate(i_hbbl)
   do J=Jsq,Jeq