Changeset 13226 for NEMO/trunk/src/OCE/ICB

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

Location:

NEMO/trunk/src/OCE/ICB

Files:

• icblbc.F90 (modified) (11 diffs)
• icbthm.F90 (modified) (4 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
                         !

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

@@ -57 +57 @@
       TYPE(point)  , POINTER ::   pt
       !
-      COMPLEX(wp), DIMENSION(jpi,jpj) :: cicb_melt, cicb_hflx
+      COMPLEX(dp), DIMENSION(jpi,jpj) :: cicb_melt, cicb_hflx
       !!----------------------------------------------------------------------
       !
       !! initialiaze cicb_melt and cicb_heat
-      cicb_melt = CMPLX( 0.e0, 0.e0, wp ) 
-      cicb_hflx = CMPLX( 0.e0, 0.e0, wp ) 
+      cicb_melt = CMPLX( 0.e0, 0.e0, dp ) 
+      cicb_hflx = CMPLX( 0.e0, 0.e0, dp ) 
       !
       z1_rday = 1._wp / rday
@@ -176 +176 @@
             !! the use of DDPDD function for the cumulative sum is needed for reproducibility
             zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s
-            CALL DDPDD( CMPLX( zmelt * z1_e1e2, 0.e0, wp ), cicb_melt(ii,ij) )
+            CALL DDPDD( CMPLX( zmelt * z1_e1e2, 0.e0, dp ), cicb_melt(ii,ij) )
             !
             ! iceberg heat flux
@@ -185 +185 @@
             zheat_hcflux = zmelt * pt%heat_density       ! heat content flux : kg/s x J/kg = J/s
             zheat_latent = - zmelt * rLfus               ! latent heat flux:  kg/s x J/kg = J/s
-            CALL DDPDD( CMPLX( ( zheat_hcflux + zheat_latent ) * z1_e1e2, 0.e0, wp ), cicb_hflx(ii,ij) )
+            CALL DDPDD( CMPLX( ( zheat_hcflux + zheat_latent ) * z1_e1e2, 0.e0, dp ), cicb_hflx(ii,ij) )
             !
             ! diagnostics
@@ -230 +230 @@
       END DO
       !
-      berg_grid%floating_melt = REAL(cicb_melt,wp)    ! kg/m2/s
-      berg_grid%calving_hflx  = REAL(cicb_hflx,wp)
+      berg_grid%floating_melt = REAL(cicb_melt,dp)    ! kg/m2/s
+      berg_grid%calving_hflx  = REAL(cicb_hflx,dp)
       !
       ! now use melt and associated heat flux in ocean (or not)