Changeset 14986 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domqco.F90

Timestamp:

2021-06-14T13:34:08+02:00 (3 years ago)

Author:

sparonuz

Message:

Merge trunk -r14984:HEAD

File:

• NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domqco.F90 (modified) (4 diffs)

NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domqco.F90

@@ -124 +124 @@
       CALL dom_qco_r3c( CASTWP(ssh(:,:,Kmm)), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) )
 #endif
+      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1]
+      IF( nn_hls == 2 ) CALL lbc_lnk( 'dom_qco_zgr', r3u(:,:,Kbb), 'U', 1._wp, r3v(:,:,Kbb), 'V', 1._wp, &
+         &                                           r3u(:,:,Kmm), 'U', 1._wp, r3v(:,:,Kmm), 'V', 1._wp )
       !
    END SUBROUTINE dom_qco_zgr
@@ -147 +150 @@
       !
       !
-      pr3t(:,:) = pssh(:,:) * r1_ht_0(:,:)   !==  ratio at t-point  ==!
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+         pr3t(ji,jj) = pssh(ji,jj) * r1_ht_0(ji,jj)   !==  ratio at t-point  ==!
+      END_2D
       !
       !
@@ -155 +160 @@
 #if ! defined key_qcoTest_FluxForm
       !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average
-         DO_2D( 0, 0, 0, 0 )
-            pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  &
-               &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj)
-            pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  &
-               &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj)
-         END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  &
+            &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj)
+         pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  &
+            &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj)
+      END_2D
 !!st      ELSE                                         !- Flux Form   (simple averaging)
 #else
-         DO_2D( 0, 0, 0, 0 )
-            pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj)
-            pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj)
-         END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj)
+         pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj)
+      END_2D
 !!st      ENDIF
 #endif         
       !
       IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only
-         CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )
          !
          !
@@ -180 +185 @@
          !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average
 
-            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
-               pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  &
-                  &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  &
-                  &                     + e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  &
-                  &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj)
-            END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
+         ! round brackets added to fix the order of floating point operations
+         ! needed to ensure halo 1 - halo 2 compatibility
+         pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   &
+            &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   &
+            &                      )                                      & ! bracket for halo 1 - halo 2 compatibility
+            &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  &
+            &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  &
+            &                       )                                     & ! bracket for halo 1 - halo 2 compatibility
+            &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj)
+      END_2D
 !!st         ELSE                                      !- Flux Form   (simple averaging)
 #else
-            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line
-               pr3f(ji,jj) = 0.25_wp * (  pssh(ji,jj  ) + pssh(ji+1,jj  )  &
-                  &                     + pssh(ji,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj)
-            END_2D
+      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+         ! round brackets added to fix the order of floating point operations
+         ! needed to ensure halo 1 - halo 2 compatibility
+         pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) &
+            &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  &
+            &                       )                                  & ! bracket for halo 1 - halo 2 compatibility
+            &                    ) * r1_hf_0(ji,jj)
+      END_2D
 !!st         ENDIF
 #endif
          !                                                 ! lbc on ratio at u-,v-,f-points
-         CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )
          !
       ENDIF