Changeset 14671 for NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/ICB/icbdia.F90

Timestamp:

2021-04-01T13:34:55+02:00 (3 years ago)

Author:

dancopsey

Message:

Merged in up to revision 14474 of the GO8_package branch

File:

• NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/ICB/icbdia.F90 (modified) (7 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_fix_topo_minor/src/OCE/ICB/icbdia.F90

@@ -83 +83 @@
    REAL(wp)                      ::  heat_to_bergs_net, heat_to_ocean_net, melt_net
    REAL(wp)                      ::  calving_to_bergs_net
+   REAL(wp)                      ::  vel_factor_min
 
    INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved
    INTEGER                       ::  nbergs_melted
-   INTEGER                       ::  nspeeding_tickets
+   INTEGER , DIMENSION(4)        ::  nspeeding_tickets
    INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class
 
@@ -124 +125 @@
       nbergs_calved             = 0
       nbergs_calved_by_class(:) = 0
-      nspeeding_tickets         = 0
+      nspeeding_tickets(:)      = 0
+      vel_factor_min            = 1._wp
       stored_heat_end           = 0._wp
       floating_heat_end         = 0._wp
@@ -157 +159 @@
       IF( lk_mpp ) THEN
          ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
-         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
+         ALLOCATE( nsumbuf(7+nclasses) )  ; nsumbuf(:) = 0
          rsumbuf(1) = floating_mass_start
          rsumbuf(2) = bergs_mass_start
@@ -265 +267 @@
             nsumbuf(2) = nbergs_calved
             nsumbuf(3) = nbergs_melted
-            nsumbuf(4) = nspeeding_tickets
+            nsumbuf(4:7) = nspeeding_tickets(:)
             DO ik = 1, nclasses
-               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
+               nsumbuf(7+ik) = nbergs_calved_by_class(ik)
             END DO
-            CALL mpp_sum( 'icbdia', nsumbuf(1:nclasses+4), nclasses+4 )
+            CALL mpp_sum( 'icbdia', nsumbuf(1:nclasses+7), nclasses+7 )
             !
             nbergs_end        = nsumbuf(1)
             nbergs_calved     = nsumbuf(2)
             nbergs_melted     = nsumbuf(3)
-            nspeeding_tickets = nsumbuf(4)
+            nspeeding_tickets(:) = nsumbuf(4:7)
             DO ik = 1,nclasses
-               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
+               nbergs_calved_by_class(ik)= nsumbuf(7+ik)
             END DO
             !
+            CALL mpp_min( 'icbdia', vel_factor_min, 1 )
          ENDIF
          !
@@ -329 +332 @@
          IF (nn_verbose_level > 0) THEN
             WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
-            IF( nspeeding_tickets > 0 )   WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets
+            WRITE( numicb, '("n speeding tickets by RK4 stage = ",i6,3(",",i6))') (nspeeding_tickets(ik),ik=1,4)
+            IF( SUM(nspeeding_tickets) > 0 ) THEN
+               WRITE( numicb, '("min velocity reduction factor = ",f12.8)') vel_factor_min
+            ENDIF
          ENDIF
          !
@@ -337 +343 @@
          nbergs_calved             = 0
          nbergs_calved_by_class(:) = 0
-         nspeeding_tickets         = 0
+         nspeeding_tickets(:)      = 0
+         vel_factor_min            = 1._wp
          stored_heat_start         = stored_heat_end
          floating_heat_start       = floating_heat_end
@@ -474 +481 @@
 
 
-   SUBROUTINE icb_dia_speed()
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      !
-      IF( .NOT.ln_bergdia )   RETURN
-      nspeeding_tickets = nspeeding_tickets + 1
+   SUBROUTINE icb_dia_speed(pvel_factor, pn_stage)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pvel_factor   ! factor by which velocity reduced
+      INTEGER , INTENT(in) ::   pn_stage  ! which stage of the RK4 calculation are we on
+      !
+      IF( (.NOT.ln_bergdia) .OR. pn_stage .lt. 1 .OR. pn_stage .gt. 4 )   RETURN
+      nspeeding_tickets(pn_stage) = nspeeding_tickets(pn_stage) + 1
+      vel_factor_min = MIN(vel_factor_min,pvel_factor)   ! keep track of minimum reduction factor
       !
    END SUBROUTINE icb_dia_speed