Merge pull request #99 from Hallberg-NOAA/restructure_dyn2

+(*)Finish restructuring SIS2 dynamics calls

src/SIS_ctrl_types.F90

@@ -4,14 +4,15 @@ module SIS_ctrl_types
 
 ! use mpp_mod,          only: mpp_sum, stdout, input_nml_file, PE_here => mpp_pe
 ! use mpp_domains_mod,  only: domain2D, mpp_get_compute_domain, CORNER, EAST, NORTH
-use mpp_domains_mod,  only: domain2D, CORNER, EAST, NORTH
-! use mpp_parameter_mod, only: CGRID_NE, BGRID_NE, AGRID
-use coupler_types_mod,only: coupler_2d_bc_type, coupler_3d_bc_type
-use coupler_types_mod,only: coupler_type_initialized, coupler_type_set_diags
+use mpp_domains_mod,   only : domain2D, CORNER, EAST, NORTH
+! use mpp_parameter_mod, only : CGRID_NE, BGRID_NE, AGRID
+use coupler_types_mod, only : coupler_2d_bc_type, coupler_3d_bc_type
+use coupler_types_mod, only : coupler_type_initialized, coupler_type_set_diags
 
 use SIS_dyn_trans,   only : dyn_trans_CS
 use SIS_fast_thermo, only : fast_thermo_CS
 use SIS_slow_thermo, only : slow_thermo_CS
+use specified_ice,   only : specified_ice_CS
 
 use SIS_hor_grid, only : SIS_hor_grid_type
 use ice_grid, only : ice_grid_type
@@ -99,6 +100,7 @@ module SIS_ctrl_types
   logical :: Cgrid_dyn      !< If true use a C-grid discretization of the
                             !! sea-ice dynamics.
 
+  logical :: slab_ice       !< If true, use the archaic GFDL slab ice.
   logical :: specified_ice  !< If true, the sea ice is specified and there is
                             !! no need for ice dynamics.
   logical :: pass_stress_mag !< If true, calculate the time-mean magnitude of the
@@ -127,6 +129,8 @@ module SIS_ctrl_types
                             !! structure for the slow ice thermodynamics.
   type(dyn_trans_CS),   pointer :: dyn_trans_CSp => NULL() !< A pointer to the control
                             !! structure for the ice dynamics and transport.
+  type(specified_ice_CS),   pointer :: specified_ice_CSp => NULL() !< A pointer to the control
+                            !! structure for the specified ice.
   type(fast_thermo_CS), pointer :: fast_thermo_CSp => NULL() !< A pointer to the control
                             !! structure for the fast ice thermodynamics.
   type(SIS_optics_CS), pointer  :: optics_CSp => NULL() !< A pointer to the control

src/SIS_slow_thermo.F90

@@ -806,9 +806,7 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG)
   bsnk(:,:) = 0.0
   salt_change(:,:) = 0.0
   h2o_change(:,:) = 0.0
-!$OMP parallel default(none) shared(isc,iec,jsc,jec,ncat,nb,G,IST,salt_change, &
-!$OMP                               kg_H_Nk,h2o_change,NkIce,IG,CS,IOF,FIA) &
-!$OMP                        private(part_ocn)
+  !$OMP parallel default(shared) private(part_ocn)
   if (CS%ice_rel_salin <= 0.0) then
     !$OMP do
     do j=jsc,jec ; do m=1,NkIce ; do k=1,ncat ; do i=isc,iec
@@ -836,12 +834,25 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG)
     IOF%lprec_ocn_top(i,j) = part_ocn * FIA%lprec_top(i,j,0)
     IOF%fprec_ocn_top(i,j) = part_ocn * FIA%fprec_top(i,j,0)
   enddo ; enddo
+
 ! mw/new precip will eventually be intercepted by pond eliminating need for next 3 lines
   !$OMP do
   do j=jsc,jec ; do k=1,ncat ; do i=isc,iec
     IOF%lprec_ocn_top(i,j) = IOF%lprec_ocn_top(i,j) + &
                              IST%part_size(i,j,k) * FIA%lprec_top(i,j,k)
   enddo ; enddo ; enddo
+
+  ! Add fluxes of snow and other properties to the ocean due to recent ridging or drifting events.
+  if (allocated(IST%snow_to_ocn)) then
+    !$OMP do
+    do j=jsc,jec ; do i=isc,iec ; if (IST%snow_to_ocn(i,j) > 0.0) then
+      IOF%fprec_ocn_top(i,j) = IOF%fprec_ocn_top(i,j) + IST%snow_to_ocn(i,j) * Idt_slow
+      IOF%Enth_Mass_out_ocn(i,j) = IOF%Enth_Mass_out_ocn(i,j) - &
+              IST%snow_to_ocn(i,j) * IST%enth_snow_to_ocn(i,j)
+      ! h2o_change(i,j) = h2o_change(i,j) - IST%snow_to_ocn(i,j)
+      IST%snow_to_ocn(i,j) = 0.0 ;  IST%enth_snow_to_ocn(i,j) = 0.0
+    endif ; enddo ; enddo
+  endif
 !$OMP end parallel
 
   ! Set up temporary tracer array

src/SIS_sum_output.F90

@@ -445,6 +445,11 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t
                   ((0.001*IST%mH_ice(i,j,k)*kg_H_nlay) * IST%sal_ice(i,j,k,L))
       enddo
     endif ; enddo
+    if (allocated(IST%snow_to_ocn)) then ; if (IST%snow_to_ocn(i,j) > 0.0) then
+      area_pt = G%areaT(i,j) * G%mask2dT(i,j)
+      col_mass(i,j,hem) = col_mass(i,j,hem) + area_pt * IST%snow_to_ocn(i,j)
+      col_heat(i,j,hem) = col_heat(i,j,hem) + area_pt * (IST%snow_to_ocn(i,j) * IST%enth_snow_to_ocn(i,j))
+    endif ; endif
     if (ice_area(i,j,hem) > 0.1*G%AreaT(i,j)) ice_extent(i,j,hem) = G%AreaT(i,j)
 
   enddo ; enddo
@@ -463,24 +468,24 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t
 ! Calculate the maximum CFL numbers.
   max_CFL = 0.0
   dt_CFL = max(CS%dt, 0.)
-  if (allocated(IST%u_ice_C)) then ; do j=js,je ; do I=is-1,ie
-    if (IST%u_ice_C(I,j) < 0.0) then
-      CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j))
-    else
-      CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j))
-    endif
-    max_CFL = max(max_CFL, CFL_trans)
-  enddo ; enddo ; endif
-  if (allocated(IST%v_ice_C)) then ; do J=js-1,je ; do i=is,ie
-    if (IST%v_ice_C(i,J) < 0.0) then
-      CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1))
-    else
-      CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j))
-    endif
-    max_CFL = max(max_CFL, CFL_trans)
-  enddo ; enddo ; endif
-  if ( .not.(allocated(IST%u_ice_C) .or. allocated(IST%v_ice_C)) .and. &
-       (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) ) then
+  if (IST%Cgrid_dyn) then
+    if (allocated(IST%u_ice_C)) then ; do j=js,je ; do I=is-1,ie
+      if (IST%u_ice_C(I,j) < 0.0) then
+        CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j))
+      else
+        CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j))
+      endif
+      max_CFL = max(max_CFL, CFL_trans)
+    enddo ; enddo ; endif
+    if (allocated(IST%v_ice_C)) then ; do J=js-1,je ; do i=is,ie
+      if (IST%v_ice_C(i,J) < 0.0) then
+        CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1))
+      else
+        CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j))
+      endif
+      max_CFL = max(max_CFL, CFL_trans)
+    enddo ; enddo ; endif
+  elseif (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) then
     do J=js-1,je ; do I=is-1,ie
       CFL_u = abs(IST%u_ice_B(I,J)) * dt_CFL * G%IdxBu(I,J)
       CFL_v = abs(IST%v_ice_B(I,J)) * dt_CFL * G%IdyBu(I,J)