Changeset 15043 for NEMO/branches/2021/ticket2696_icb_halo1_halo2_compatibility/src/OCE/ICB/icblbc.F90

Timestamp:

2021-06-22T13:26:16+02:00 (3 years ago)

Author:

acc

Message:

#2696 .A possible fix for obtaining identical results with icebergs active and with either
nn_hls=1 or nn_hls=2. This solution works by ensuring the real-valued iceberg position
calculations are done with identical numbers in both cases. Iceberg positions are stored
as a continuous local grid-cell value and a factor of (nn_hls-1) is subtracted from
initial positions to ensure equivalence in both cases. This factor needs to be added
back whenever iceberg positions are converted to local indices. The changes in this
commit are enough to ensure a full ORCA2_ICE_PISCES SETTE test is passed in both case
(992 timesteps) and provides identical results. Suitability of this solution for inclusion
in the trunk needs to be discussed and verified on other platforms and compilers.

File:

• NEMO/branches/2021/ticket2696_icb_halo1_halo2_compatibility/src/OCE/ICB/icblbc.F90 (modified) (7 diffs)

NEMO/branches/2021/ticket2696_icb_halo1_halo2_compatibility/src/OCE/ICB/icblbc.F90

@@ -229 +229 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN
+            IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN
                tmpberg => this
                this => this%next
@@ -242 +242 @@
                CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e)
                CALL icb_utl_delete(first_berg, tmpberg)
-            ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN
+            ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN
                tmpberg => this
                this => this%next
@@ -321 +321 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+            IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
                tmpberg => this
                this => this%next
@@ -331 +331 @@
                CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n)
                CALL icb_utl_delete(first_berg, tmpberg)
-            ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN
+            ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN
                tmpberg => this
                this => this%next
@@ -442 +442 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp .OR. &
-                pt%xi > REAL(mig(nicbei),wp) + 0.5_wp .OR. &
-                pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp .OR. &
-                pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+            IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. &
+                pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. &
+                pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. &
+                pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
                i = i + 1
                WRITE(numicb,*) 'berg lost in halo: ', this%number(:)
@@ -514 +514 @@
                DO WHILE (ASSOCIATED(this))
                   pt => this%current_point
-                  iine = INT( pt%xi + 0.5 )
+                  iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
                   iproc = nicbflddest(mi1(iine))
-                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
                      IF( iproc == ifldproc ) THEN
                         !
@@ -592 +592 @@
                DO WHILE (ASSOCIATED(this))
                   pt => this%current_point
-                  iine = INT( pt%xi + 0.5 )
-                  ijne = INT( pt%yj + 0.5 )
+                  iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
+                  ijne = INT( pt%yj + 0.5 ) + (nn_hls-1)
                   ipts  = nicbfldpts (mi1(iine))
                   iproc = nicbflddest(mi1(iine))
-                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
                      IF( iproc == ifldproc ) THEN
                         !