Changeset 237 for trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90

Timestamp:

2005-03-22T11:18:01+01:00 (19 years ago)

Author:

opalod

Message:

CT : UPDATE171 : vectorial optimization of the nonosc subroutine

File:

• trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90 (modified) (4 diffs)

trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90

@@ -401 +401 @@
       ! --------------------
       ! large negative value (-zbig) inside land
-      WHERE( tmask(:,:,:) == 0. )
-         pbef(:,:,:) = -zbig
-         paft(:,:,:) = -zbig
-      ENDWHERE 
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
       ! search maximum in neighbourhood
       DO jk = 1, jpkm1
@@ -421 +419 @@
       END DO
       ! large positive value (+zbig) inside land
-      WHERE( tmask(:,:,:) == 0. )
-         pbef(:,:,:) = +zbig
-         paft(:,:,:) = +zbig
-      ENDWHERE
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
       ! search minimum in neighbourhood
       DO jk = 1, jpkm1
@@ -473 +469 @@
 
 
-      ! 3. monotonic flux in the i direction, i.e. paa
-      ! ----------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = paa(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-                  paa(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-                  paa(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on paa   (changed sign)
-      CALL lbc_lnk( paa, 'U', -1. )
-
-
-      ! 4. monotonic flux in the j direction, i.e. pbb
-      ! ----------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = pbb(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-                  pbb(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-                  pbb(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on pbb   (changed sign)
-      CALL lbc_lnk( pbb, 'V', -1. )
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+
+               za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+            END DO
+         END DO
+      END DO
 
 
@@ -520 +493 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = pcc(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
-                  pcc(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
-                  pcc(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on pcc   (unchanged sign)
-      CALL lbc_lnk( pcc, 'W', 1. )
+
+               za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+               zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
+               pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on paa, pbb, pcc
+      CALL lbc_lnk( paa, 'U', -1. )      ! changed sign
+      CALL lbc_lnk( pbb, 'V', -1. )      ! changed sign
+      CALL lbc_lnk( pcc, 'W',  1. )      ! NO changed sign
 
    END SUBROUTINE nonosc