New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2005 – NEMO

Changeset 2005


Ignore:
Timestamp:
2010-07-09T15:07:02+02:00 (14 years ago)
Author:
mlelod
Message:

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

Location:
branches/DEV_r1837_MLF/NEMO/OPA_SRC
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/DOM/domvvl.F90

    r1694 r2005  
    5151      !!---------------------------------------------------------------------- 
    5252      INTEGER  ::   ji, jj, jk 
    53       REAL(wp) ::   zcoefu, zcoefv, zcoeff 
     53      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars 
     54      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        - 
     55      REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      !     -     2D workspace 
    5456      !!---------------------------------------------------------------------- 
    5557 
     
    115117         hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 
    116118      END DO 
     119       
     120      ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 
     121      ! for ssh and scale factors 
     122      zs_t  (:,:) =       e1t(:,:) * e2t(:,:) 
     123      zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:) 
     124      zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:) 
    117125 
    118126      DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points 
    119127         DO ji = 1, jpim1   ! NO vector opt. 
    120             zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
    121             zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
    122             zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
    123             sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
    124                &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )    
    125             sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
    126                &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )    
    127             sshf_b(ji,jj) = zcoeff * ( sshb(ji  ,jj) + sshb(ji  ,jj+1)                 & 
    128                &                     + sshb(ji+1,jj) + sshb(ji+1,jj+1) )                
    129             sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
    130                &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )    
    131             sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     &  
    132                &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )      
    133             sshf_n(ji,jj) = zcoeff * ( sshn(ji  ,jj) + sshn(ji  ,jj+1)                 & 
    134                &                     + sshn(ji+1,jj) + sshn(ji+1,jj+1) )                
     128            zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj) 
     129            zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj) 
     130            zcoeff = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     131            ! before fields 
     132            zv_t_ij       = zs_t(ji  ,jj  ) * sshb(ji  ,jj  ,jk) 
     133            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshb(ji+1,jj  ,jk) 
     134            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshb(ji  ,jj+1,jk) 
     135            sshu_b(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j ) 
     136            sshv_b(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 ) 
     137            ! now fields 
     138            zv_t_ij       = zs_t(ji  ,jj  ) * sshn(ji  ,jj  ,jk) 
     139            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshn(ji+1,jj  ,jk) 
     140            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1,jk) 
     141            zv_t_ip1jp1   = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1,jk) 
     142            sshu_n(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j ) 
     143            sshv_n(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 ) 
     144            sshf_n(ji,jj) = zcoeff * ( zv_t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 ) 
    135145         END DO 
    136146      END DO 
    137       CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )      ! lateral boundary conditions 
    138       CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
    139       CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. ) 
     147      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions 
     148      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. ) 
     149      CALL lbc_lnk( sshf_n, 'F', 1. ) 
     150 
     151                                                ! initialise before scale factors at (u/v)-points 
     152      ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
     153      DO jk = 1, jpkm1 
     154         DO jj = 1, jpjm1 
     155            DO ji = 1, jpim1 
     156               zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
     157               zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
     158               zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
     159               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) ) 
     160               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) ) 
     161            END DO 
     162         END DO 
     163      END DO 
     164      CALL lbc_lnk( fse3u_b, 'U', 1. )               ! lateral boundary conditions 
     165      CALL lbc_lnk( fse3v_b, 'U', 1. ) 
     166      ! Add initial scale factor to scale factor anomaly 
     167      fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 
     168      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    140169      ! 
    141170   END SUBROUTINE dom_vvl 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/DOM/domzgr_substitute.h90

    r1565 r2005  
    4646#   define  fse3vw(i,j,k)  e3vw_1(i,j,k) 
    4747 
    48 #   define  fsdept_b(i,j,k)  (fsdept_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))) 
    49 #   define  fsdepw_b(i,j,k)  (fsdepw_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))) 
    50 #   define  fsde3w_b(i,j,k)  (fsde3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))-sshb(i,j)) 
    51 #   define  fse3t_b(i,j,k)   (fse3t_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))) 
    52 #   define  fse3u_b(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k))) 
    53 #   define  fse3v_b(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k))) 
    54 #   define  fse3f_b(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_b(i,j)*muf(i,j,k))) 
    55 #   define  fse3w_b(i,j,k)   (fse3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))) 
     48#   define  fse3t_b(i,j,k)   e3t_b(i,j,k) 
     49#   define  fse3u_b(i,j,k)   e3u_b(i,j,k) 
     50#   define  fse3v_b(i,j,k)   e3v_b(i,j,k) 
    5651#   define  fse3uw_b(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k))) 
    5752#   define  fse3vw_b(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k))) 
     
    6863#   define  fse3vw_n(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_n(i,j)*muv(i,j,k))) 
    6964 
    70 #   define  fse3t_m(i,j,k)   (fse3t_0(i,j,k)*(1.+ssh_m(i,j)*mut(i,j,k))) 
     65#   define  fse3t_m(i,j,k)   e3t_m(i,j,k) 
    7166 
    72 #   define  fsdept_a(i,j,k)  (fsdept_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))) 
    73 #   define  fsdepw_a(i,j,k)  (fsdepw_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))) 
    74 #   define  fsde3w_a(i,j,k)  (fsde3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))-ssha(i,j)) 
    7567#   define  fse3t_a(i,j,k)   (fse3t_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))) 
    7668#   define  fse3u_a(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k))) 
    7769#   define  fse3v_a(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k))) 
    78 #   define  fse3f_a(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_a(i,j)*muf(i,j,k))) 
    79 #   define  fse3w_a(i,j,k)   (fse3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))) 
    80 #   define  fse3uw_a(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k))) 
    81 #   define  fse3vw_a(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k))) 
    8270 
    8371#else 
     
    9482#   define  fse3vw(i,j,k)  fse3vw_0(i,j,k) 
    9583 
    96 #   define  fsdept_b(i,j,k)  fsdept_0(i,j,k) 
    97 #   define  fsdepw_b(i,j,k)  fsdepw_0(i,j,k) 
    98 #   define  fsde3w_b(i,j,k)  fsde3w_0(i,j,k) 
    9984#   define  fse3t_b(i,j,k)   fse3t_0(i,j,k) 
    10085#   define  fse3u_b(i,j,k)   fse3u_0(i,j,k) 
    10186#   define  fse3v_b(i,j,k)   fse3v_0(i,j,k) 
    102 #   define  fse3f_b(i,j,k)   fse3f_0(i,j,k) 
    103 #   define  fse3w_b(i,j,k)   fse3w_0(i,j,k) 
    10487#   define  fse3uw_b(i,j,k)  fse3uw_0(i,j,k) 
    10588#   define  fse3vw_b(i,j,k)  fse3vw_0(i,j,k) 
     
    118101#   define  fse3t_m(i,j,k)   fse3t_0(i,j,k) 
    119102 
    120 #   define  fsdept_a(i,j,k)  fsdept_0(i,j,k) 
    121 #   define  fsdepw_a(i,j,k)  fsdepw_0(i,j,k) 
    122 #   define  fsde3w_a(i,j,k)  fsde3w_0(i,j,k) 
    123103#   define  fse3t_a(i,j,k)   fse3t_0(i,j,k) 
    124104#   define  fse3u_a(i,j,k)   fse3u_0(i,j,k) 
    125105#   define  fse3v_a(i,j,k)   fse3v_0(i,j,k) 
    126 #   define  fse3f_a(i,j,k)   fse3f_0(i,j,k) 
    127 #   define  fse3w_a(i,j,k)   fse3w_0(i,j,k) 
    128 #   define  fse3uw_a(i,j,k)  fse3uw_0(i,j,k) 
    129 #   define  fse3vw_a(i,j,k)  fse3vw_0(i,j,k) 
    130106#endif 
    131107   !!---------------------------------------------------------------------- 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/dynnxt.F90

    r1975 r2005  
    8787      !!               un,vn   now horizontal velocity of next time-step 
    8888      !!---------------------------------------------------------------------- 
     89#if defined key_vvl 
     90      USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace 
     91      USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace 
     92#endif 
    8993      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    9094      !! 
     
    9599      REAL(wp) ::   zue3a , zue3n , zue3b    ! temporary scalar 
    96100      REAL(wp) ::   zve3a , zve3n , zve3b    !    -         - 
    97       REAL(wp) ::   ze3u_b, ze3u_n, ze3u_a   !    -         - 
    98       REAL(wp) ::   ze3v_b, ze3v_n, ze3v_a   !    -         -  
    99101      REAL(wp) ::   zuf   , zvf              !    -         -  
     102      REAL(wp) ::   zec                      !    -         -  
     103      REAL(wp) ::   zv_t_ij  , zv_t_ip1j     !     -        - 
     104      REAL(wp) ::   zv_t_ijp1                !     -        - 
     105      REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      ! temporary 2D workspace 
    100106      !!---------------------------------------------------------------------- 
    101107 
     
    216222               DO jj = 1, jpj 
    217223                  DO ji = 1, jpi     
    218                      zuf = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk) 
    219                      zvf = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk) 
     224                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     225                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) ) 
    220226                     ! 
    221227                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
     
    227233            END DO 
    228234         ELSE                                                ! applied on thickness weighted velocity 
     235            ! Before scale factors at (t/u/v)-points (actually "now filtered" and futur "before") 
     236            ! ====================================== 
     237            ! Scale factor at t-points 
     238            ! ------------------------ 
     239            fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * fse3t_m(:,:,:) 
     240            ! Add volume filter correction only at the first level of t-point scale factors 
     241            zec = atfp * rdt / rau0 
     242            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
     243            ! Scale factor at (u/v)-points 
     244            ! ------------------------ 
     245            ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 
     246            zs_t  (:,:) =       e1t(:,:) * e2t(:,:) 
     247            zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:) 
     248            zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:) 
     249            ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
     250            DO jk = 1, jpkm1 
     251               DO jj = 1, jpjm1 
     252                  DO ji = 1, jpim1 
     253                     zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
     254                     zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
     255                     zv_t_ijp1        = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
     256                     ze3u_f(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 
     257                     ze3v_f(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 
     258                  END DO 
     259               END DO 
     260            END DO 
     261            CALL lbc_lnk( ze3u_f, 'U', 1. )               ! lateral boundary conditions 
     262            CALL lbc_lnk( ze3v_f, 'U', 1. ) 
     263            ! Add initial scale factor to scale factor anomaly 
     264            ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 
     265            ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 
     266             
    229267            DO jk = 1, jpkm1 
    230268               DO jj = 1, jpj 
    231                   DO ji = 1, jpi 
    232                      ze3u_a = fse3u_a(ji,jj,jk) 
    233                      ze3v_a = fse3v_a(ji,jj,jk) 
    234                      ze3u_n = fse3u_n(ji,jj,jk) 
    235                      ze3v_n = fse3v_n(ji,jj,jk) 
    236                      ze3u_b = fse3u_b(ji,jj,jk) 
    237                      ze3v_b = fse3v_b(ji,jj,jk) 
     269                  DO ji = 1, jpim 
     270                     zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 
     271                     zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 
     272                     zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk) 
     273                     zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk) 
     274                     zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 
     275                     zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 
    238276                     ! 
    239                      zue3a = ua(ji,jj,jk) * ze3u_a 
    240                      zve3a = va(ji,jj,jk) * ze3v_a 
    241                      zue3n = un(ji,jj,jk) * ze3u_n 
    242                      zve3n = vn(ji,jj,jk) * ze3v_n 
    243                      zue3b = ub(ji,jj,jk) * ze3u_b 
    244                      zve3b = vb(ji,jj,jk) * ze3v_b 
    245                      ! 
    246                      zuf  = ( atfp * ( zue3b  + zue3a  ) + atfp1 * zue3n  )   & 
    247                         & / ( atfp * ( ze3u_b + ze3u_a ) + atfp1 * ze3u_n ) * umask(ji,jj,jk) 
    248                      zvf  = ( atfp * ( zve3b  + zve3a  ) + atfp1 * zve3n  )   & 
    249                         & / ( atfp * ( ze3v_b + ze3v_a ) + atfp1 * ze3v_n ) * vmask(ji,jj,jk) 
     277                     zuf  = ( zue3n + atfp * ( zue3b  - 2.e0 * zue3n  + zue3a  ) ) / ze3u_f(ji,jj,jk) 
     278                     zvf  = ( zve3n + atfp * ( zve3b  - 2.e0 * zve3n  + zve3a  ) ) / ze3v_f(ji,jj,jk) 
    250279                     ! 
    251280                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    252281                     vb(ji,jj,jk) = zvf 
     282                     fse3u_b(ji,jj,jk) = ze3u_f(ji,jj,jk)    ! e3u_b <-- filtered scale factor 
     283                     fse3v_b(ji,jj,jk) = ze3v_f(ji,jj,jk) 
    253284                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
    254285                     vn(ji,jj,jk) = va(ji,jj,jk) 
     
    256287               END DO 
    257288            END DO 
     289            CALL lbc_lnk( ub, 'U', -1. )         ! local domain boundaries 
     290            CALL lbc_lnk( vb, 'V', -1. )  
    258291         ENDIF 
    259292      ENDIF 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/sshwzv.F90

    r1975 r2005  
    189189         CALL lbc_lnk( sshu_a, 'U', 1. ) 
    190190         CALL lbc_lnk( sshv_a, 'V', 1. ) 
    191          DO jj = 1, jpjm1 
    192             DO ji = 1, jpim1      ! NO Vector Opt. 
    193                sshf_a(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    194                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    195                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_a(ji,jj  )     & 
    196                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_a(ji,jj+1) ) 
    197             END DO 
    198          END DO 
    199          ! Boundaries conditions 
    200          CALL lbc_lnk( sshf_a, 'F', 1. ) 
    201       ENDIF 
    202  
     191      ENDIF 
     192      !                                           !----------------------------------------! 
     193      !                                           !     vertical scale factor laplacian    ! 
     194      !                                           !----------------------------------------! 
     195      ! Needed for Robert-Asselin time filter and for Brown & Campana semi implicit hydrostatic presure gradient 
     196      fse3t_m(:,:,:) =          fse3t_b(:,:,:)   & 
     197         &             - 2.e0 * fse3t_n(:,:,:)   & 
     198         &             +        fse3t_a(:,:,:) 
    203199      !                                           !------------------------------! 
    204200      !                                           !     Now Vertical Velocity    ! 
     
    219215      CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    220216      IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value 
     217         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    221218         z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 
    222219         DO jk = 1, jpk 
     
    264261 
    265262      !                       !--------------------------! 
    266       IF( lk_vvl ) THEN       !  Variable volume levels  !   ssh at t-, u-, v, f-points 
     263      IF( lk_vvl ) THEN       !  Variable volume levels  ! 
    267264         !                    !--------------------------! 
     265         ! 
     266         ! ssh at t-, u-, v, f-points 
     267         !=========================== 
    268268         IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    269269            sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now) 
    270270            sshu_n(:,:) = sshu_a(:,:) 
    271271            sshv_n(:,:) = sshv_a(:,:) 
    272             sshf_n(:,:) = sshf_a(:,:) 
     272            DO jj = 1, jpjm1 
     273               DO ji = 1, jpim1      ! NO Vector Opt. 
     274                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
     275                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     276                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     277                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     278               END DO 
     279            END DO 
     280            ! Boundaries conditions 
     281            CALL lbc_lnk( sshf_n, 'F', 1. ) 
    273282         ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
    274             zec = atfp * rdt / rau0 
    275283            DO jj = 1, jpj 
    276284               DO ji = 1, jpi                                ! before <-- now filtered 
     
    280288                  sshu_n(ji,jj) = sshu_a(ji,jj) 
    281289                  sshv_n(ji,jj) = sshv_a(ji,jj) 
    282                   sshf_n(ji,jj) = sshf_a(ji,jj) 
    283                END DO 
    284             END DO 
     290               END DO 
     291            END DO 
     292            DO jj = 1, jpjm1 
     293               DO ji = 1, jpim1      ! NO Vector Opt. 
     294                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
     295                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     296                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     297                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     298               END DO 
     299            END DO 
     300            ! Boundaries conditions 
     301            CALL lbc_lnk( sshf_n, 'F', 1. ) 
    285302            DO jj = 1, jpjm1 
    286303               DO ji = 1, jpim1      ! NO Vector Opt. 
     
    296313            CALL lbc_lnk( sshu_b, 'U', 1. ) 
    297314            CALL lbc_lnk( sshv_b, 'V', 1. ) 
    298             DO jj = 1, jpjm1 
    299                DO ji = 1, jpim1      ! NO Vector Opt. 
    300                   sshf_b(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    301                      &                 / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    302                      &                 * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_b(ji,jj  )     & 
    303                      &                   + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_b(ji,jj+1) ) 
    304                END DO 
    305             END DO 
    306             ! Boundaries conditions 
    307             CALL lbc_lnk( sshf_b, 'F', 1. ) 
    308315         ENDIF 
    309316         !                    !--------------------------! 
    310       ELSE                    !        fixed levels      !   ssh at t-point only 
     317      ELSE                    !        fixed levels      ! 
    311318         !                    !--------------------------! 
     319         ! 
     320         ! ssh at t-point only 
     321         !==================== 
    312322         IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    313323            sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now) 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/IOM/restart.F90

    r1975 r2005  
    122122      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb   ) 
    123123      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb    ) 
     124      IF( lk_vvl ) THEN 
     125         CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b ) 
     126      ENDIF 
    124127      ! 
    125128      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un      )     ! now fields 
     
    191194      CALL iom_get( numror, jpdom_autoglo, 'hdivb', hdivb ) 
    192195      CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb  ) 
     196      IF( lk_vvl ) THEN 
     197         CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b ) 
     198      ENDIF 
    193199      ! 
    194200      CALL iom_get( numror, jpdom_autoglo, 'un'   , un    )        ! now    fields 
     
    217223         hdivb(:,:,:) = hdivn(:,:,:) 
    218224         sshb (:,:)   = sshn (:,:) 
    219          ! - ML - sshbnc  
     225         IF( lk_vvl ) THEN 
     226            fse3t_b(:,:,:) = fse3t_n(:,:,:) 
     227         ENDIF 
    220228      ENDIF 
    221229      ! 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA/tranxt.F90

    r1975 r2005  
    282282                  ze3t_n = fse3t_n(ji,jj,jk) 
    283283                  ze3t_a = fse3t_a(ji,jj,jk) 
     284                  ze3t_m = fse3t_m(ji,jj,jk) 
    284285                  !                                         ! tracer content at Before, now and after 
    285286                  ztc_b  = tb(ji,jj,jk) * ze3t_b   ;   zsc_b = sb(ji,jj,jk) * ze3t_b 
     
    287288                  ztc_a  = ta(ji,jj,jk) * ze3t_a   ;   zsc_a = sa(ji,jj,jk) * ze3t_a 
    288289                  ! 
    289                   !                                         ! Time laplacian on thickness and tracer content 
     290                  !                                         ! Time laplacian on tracer contents 
    290291                  !                                         ! used for both Asselin and Brown & Campana filters 
    291                   ze3t_m = ze3t_a - 2. * ze3t_n + ze3t_b 
    292292                  ztc_m  = ztc_a  - 2. * ztc_n  + ztc_b 
    293293                  zsc_m  = zsc_a  - 2. * zsc_n  + zsc_b 
    294                   !                                         ! Asselin Filter + correction 
     294                  !                                         ! Asselin Filter on thicknesses and tracer contents 
    295295                  ze3t_f = ze3t_n + atfp * ze3t_m 
    296296                  ztc_f  = ztc_n  + atfp * ztc_m 
    297297                  zsc_f  = zsc_n  + atfp * zsc_m 
    298  
     298                  !                                         ! Filter correction 
    299299                  IF( jk == 1 ) THEN 
    300300                     ze3t_f = ze3t_f - zfact2 * ( emp_b       (ji,jj)    - emp         (ji,jj)    ) 
     
    312312                  !                                         ! semi imlicit hpg computation (Brown & Campana) 
    313313                  IF( ln_dynhpg_imp ) THEN 
    314                      ze3t_m = 1.e0 / ( ze3t_n + rbcp * ze3t_m ) 
    315                      ta(ji,jj,jk) =  ( ztc_n  + rbcp * ztc_m  ) * ze3t_m  ! ta <-- Brown & Campana average 
    316                      sa(ji,jj,jk) =  ( zsc_n  + rbcp * zsc_m  ) * ze3t_m  ! sa <-- Brown & Campana average 
     314                     ze3t_m       = 1.e0  / ( ze3t_n + rbcp * ze3t_m ) 
     315                     ta(ji,jj,jk) = ze3t_m * ( ztc_n  + rbcp * ztc_m  )   ! ta <-- Brown & Campana average 
     316                     sa(ji,jj,jk) = ze3t_m * ( zsc_n  + rbcp * zsc_m  )   ! sa <-- Brown & Campana average 
    317317                  ENDIF 
    318318               END DO 
  • branches/DEV_r1837_MLF/NEMO/OPA_SRC/oce.F90

    r1601 r2005  
    4747   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshu_b ,  sshu_n  ,  sshu_a  !: sea surface height at u-point [m] 
    4848   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m] 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshf_b ,  sshf_n  ,  sshf_a  !: sea surface height at f-point [m] 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::             sshf_n             !: sea surface height at f-point [m] 
    5050 
    5151   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.