Changeset 13226 for NEMO/trunk/src/OCE/ICB/icblbc.F90

Timestamp:

2020-07-02T16:24:31+02:00 (4 years ago)

Author:

orioltp

Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

File:

• NEMO/trunk/src/OCE/ICB/icblbc.F90 (modified) (11 diffs)

NEMO/trunk/src/OCE/ICB/icblbc.F90

@@ -81 +81 @@
       TYPE(iceberg), POINTER ::   this
       TYPE(point)  , POINTER ::   pt
-      INTEGER                ::   iine
       !!----------------------------------------------------------------------
 
@@ -92 +91 @@
          DO WHILE( ASSOCIATED(this) )
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
-            IF( iine > mig(nicbei) ) THEN
+            IF( pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN
                pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp
-            ELSE IF( iine < mig(nicbdi) ) THEN
+            ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN
                pt%xi = ricb_left + MOD(pt%xi, 1._wp )
             ENDIF
@@ -128 +126 @@
          pt => this%current_point
          ijne = INT( pt%yj + 0.5 )
-         IF( ijne .GT. mjg(nicbej) ) THEN
+         IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
             !
             iine = INT( pt%xi + 0.5 )
@@ -170 +168 @@
       INTEGER                             ::   ibergs_rcvd_from_n, ibergs_rcvd_from_s
       INTEGER                             ::   i, ibergs_start, ibergs_end
-      INTEGER                             ::   iine, ijne
       INTEGER                             ::   ipe_N, ipe_S, ipe_W, ipe_E
       REAL(wp), DIMENSION(2)              ::   zewbergs, zwebergs, znsbergs, zsnbergs
@@ -234 +231 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
-            IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN
+            IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN
                tmpberg => this
                this => this%next
@@ -248 +244 @@
                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. iine < mig(nicbdi) ) THEN
+            ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN
                tmpberg => this
                this => this%next
@@ -372 +368 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            ijne = INT( pt%yj + 0.5 )
-            IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN
+            IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
                tmpberg => this
                this => this%next
@@ -383 +378 @@
                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. ijne .LT. mjg(nicbdj) ) THEN
+            ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN
                tmpberg => this
                this => this%next
@@ -539 +534 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
-            ijne = INT( pt%yj + 0.5 )
-            IF( iine .LT. mig(nicbdi) .OR. &
-                iine .GT. mig(nicbei) .OR. &
-                ijne .LT. mjg(nicbdj) .OR. &
-                ijne .GT. mjg(nicbej)) THEN
+            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
                i = i + 1
-               WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne
+               WRITE(numicb,*) 'berg lost in halo: ', this%number(:)
                WRITE(numicb,*) '                   ', nimpp, njmpp
                WRITE(numicb,*) '                   ', nicbdi, nicbei, nicbdj, nicbej
@@ -614 +607 @@
                   pt => this%current_point
                   iine = INT( pt%xi + 0.5 )
-                  ijne = INT( pt%yj + 0.5 )
                   iproc = nicbflddest(mi1(iine))
-                  IF( ijne .GT. mjg(nicbej) ) THEN
+                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
                      IF( iproc == ifldproc ) THEN
                         !
@@ -696 +688 @@
                   ipts  = nicbfldpts (mi1(iine))
                   iproc = nicbflddest(mi1(iine))
-                  IF( ijne .GT. mjg(nicbej) ) THEN
+                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
                      IF( iproc == ifldproc ) THEN
                         !