Changeset 2005 for branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/sshwzv.F90

Timestamp:

2010-07-09T15:07:02+02:00 (14 years ago)

Author:

mlelod

Message:

ticket: #663 MLF: second part (local compatibility essentially)

File:

• branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/sshwzv.F90 (modified) (5 diffs)

branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/sshwzv.F90

@@ -189 +189 @@
          CALL lbc_lnk( sshu_a, 'U', 1. )
          CALL lbc_lnk( sshv_a, 'V', 1. )
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               sshf_a(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
-                    &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
-                    &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_a(ji,jj  )     &
-                    &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_a(ji,jj+1) )
-            END DO
-         END DO
-         ! Boundaries conditions
-         CALL lbc_lnk( sshf_a, 'F', 1. )
-      ENDIF
-
+      ENDIF
+      !                                           !----------------------------------------!
+      !                                           !     vertical scale factor laplacian    !
+      !                                           !----------------------------------------!
+      ! Needed for Robert-Asselin time filter and for Brown & Campana semi implicit hydrostatic presure gradient
+      fse3t_m(:,:,:) =          fse3t_b(:,:,:)   &
+         &             - 2.e0 * fse3t_n(:,:,:)   &
+         &             +        fse3t_a(:,:,:)
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
@@ -219 +215 @@
       CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
       IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value
+         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
          z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:)
          DO jk = 1, jpk
@@ -264 +261 @@
 
       !                       !--------------------------!
-      IF( lk_vvl ) THEN       !  Variable volume levels  !   ssh at t-, u-, v, f-points
+      IF( lk_vvl ) THEN       !  Variable volume levels  !
          !                    !--------------------------!
+         !
+         ! ssh at t-, u-, v, f-points
+         !===========================
          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter
             sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now)
             sshu_n(:,:) = sshu_a(:,:)
             sshv_n(:,:) = sshv_a(:,:)
-            sshf_n(:,:) = sshf_a(:,:)
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            ! Boundaries conditions
+            CALL lbc_lnk( sshf_n, 'F', 1. )
          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap
-            zec = atfp * rdt / rau0
             DO jj = 1, jpj
                DO ji = 1, jpi                                ! before <-- now filtered
@@ -280 +288 @@
                   sshu_n(ji,jj) = sshu_a(ji,jj)
                   sshv_n(ji,jj) = sshv_a(ji,jj)
-                  sshf_n(ji,jj) = sshf_a(ji,jj)
-               END DO
-            END DO
+               END DO
+            END DO
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            ! Boundaries conditions
+            CALL lbc_lnk( sshf_n, 'F', 1. )
             DO jj = 1, jpjm1
                DO ji = 1, jpim1      ! NO Vector Opt.
@@ -296 +313 @@
             CALL lbc_lnk( sshu_b, 'U', 1. )
             CALL lbc_lnk( sshv_b, 'V', 1. )
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1      ! NO Vector Opt.
-                  sshf_b(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
-                     &                 / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
-                     &                 * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_b(ji,jj  )     &
-                     &                   + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_b(ji,jj+1) )
-               END DO
-            END DO
-            ! Boundaries conditions
-            CALL lbc_lnk( sshf_b, 'F', 1. )
          ENDIF
          !                    !--------------------------!
-      ELSE                    !        fixed levels      !   ssh at t-point only
+      ELSE                    !        fixed levels      !
          !                    !--------------------------!
+         !
+         ! ssh at t-point only
+         !====================
          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter
             sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now)