Changeset 2005 for branches/DEV_r1837_MLF/NEMO/OPA_SRC/DOM/domvvl.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/DOM/domvvl.F90 (modified) (2 diffs)

branches/DEV_r1837_MLF/NEMO/OPA_SRC/DOM/domvvl.F90

@@ -51 +51 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff
+      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars
+      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        -
+      REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      !     -     2D workspace
       !!----------------------------------------------------------------------
 
@@ -115 +117 @@
          hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
       END DO
+      
+      ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations
+      ! for ssh and scale factors
+      zs_t  (:,:) =       e1t(:,:) * e2t(:,:)
+      zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:)
+      zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:)
 
       DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points
          DO ji = 1, jpim1   ! NO vector opt.
-            zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
-            zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
-            zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
-            sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
-               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )   
-            sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
-               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )   
-            sshf_b(ji,jj) = zcoeff * ( sshb(ji  ,jj) + sshb(ji  ,jj+1)                 &
-               &                     + sshb(ji+1,jj) + sshb(ji+1,jj+1) )               
-            sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
-               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )   
-            sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
-               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )     
-            sshf_n(ji,jj) = zcoeff * ( sshn(ji  ,jj) + sshn(ji  ,jj+1)                 &
-               &                     + sshn(ji+1,jj) + sshn(ji+1,jj+1) )               
+            zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj)
+            zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj)
+            zcoeff = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj) )
+            ! before fields
+            zv_t_ij       = zs_t(ji  ,jj  ) * sshb(ji  ,jj  ,jk)
+            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshb(ji+1,jj  ,jk)
+            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshb(ji  ,jj+1,jk)
+            sshu_b(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j )
+            sshv_b(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 )
+            ! now fields
+            zv_t_ij       = zs_t(ji  ,jj  ) * sshn(ji  ,jj  ,jk)
+            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshn(ji+1,jj  ,jk)
+            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1,jk)
+            zv_t_ip1jp1   = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1,jk)
+            sshu_n(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j )
+            sshv_n(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 )
+            sshf_n(ji,jj) = zcoeff * ( zv_t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 )
          END DO
       END DO
-      CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )      ! lateral boundary conditions
-      CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
-      CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. )
+      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions
+      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. )
+      CALL lbc_lnk( sshf_n, 'F', 1. )
+
+                                                ! initialise before scale factors at (u/v)-points
+      ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
+               zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
+               zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk)
+               fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) )
+               fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( fse3u_b, 'U', 1. )               ! lateral boundary conditions
+      CALL lbc_lnk( fse3v_b, 'U', 1. )
+      ! Add initial scale factor to scale factor anomaly
+      fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:)
+      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:)
       !
    END SUBROUTINE dom_vvl