Changeset 14834 for NEMO/trunk/src/OCE/DOM/domqco.F90

Timestamp:

2021-05-11T11:24:44+02:00 (3 years ago)

Author:

hadcv

Message:

#2600: Merge in dev_r14273_HPC-02_Daley_Tiling

File:

• NEMO/trunk/src/OCE/DOM/domqco.F90 (modified) (4 diffs)

NEMO/trunk/src/OCE/DOM/domqco.F90

@@ -123 +123 @@
       CALL dom_qco_r3c( 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
@@ -146 +149 @@
       !
       !
-      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
       !
       !
@@ -154 +159 @@
 #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 )
          !
          !
@@ -179 +184 @@
          !                                ! 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
-               ! 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
+      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
-               ! 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
+      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