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 2148 for branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90 – NEMO

Ignore:
Timestamp:
2010-10-04T15:53:42+02:00 (14 years ago)
Author:
cetlod
Message:

merge LOCEAN 2010 developments branches

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90

    r1970 r2148  
    2222   USE oce             ! ocean dynamics and tracers 
    2323   USE dom_oce         ! ocean space and time domain 
     24   USE sbc_oce         ! Surface boundary condition: ocean fields 
     25   USE phycst          ! physical constants 
    2426   USE dynspg_oce      ! type of surface pressure gradient 
    2527   USE dynadv          ! dynamics: vector invariant versus flux form 
     
    8789      !!               un,vn   now horizontal velocity of next time-step 
    8890      !!---------------------------------------------------------------------- 
     91      USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace 
     92      USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace 
    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 
     
    146152# if defined key_obc 
    147153      !                                !* OBC open boundaries 
    148       IF( lk_obc )   CALL obc_dyn( kt ) 
     154      CALL obc_dyn( kt ) 
    149155      ! 
    150156      IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 
     
    212218         END DO 
    213219      ELSE                                             !* Leap-Frog : Asselin filter and swap 
    214          IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN          ! applied on velocity 
     220         !                                ! =============! 
     221         IF( .NOT. lk_vvl ) THEN          ! Fixed volume ! 
     222            !                             ! =============! 
    215223            DO jk = 1, jpkm1                               
    216224               DO jj = 1, jpj 
    217225                  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) 
     226                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     227                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) ) 
    220228                     ! 
    221229                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
     
    226234               END DO 
    227235            END DO 
    228          ELSE                                                ! applied on thickness weighted velocity 
     236            !                             ! ================! 
     237         ELSE                             ! Variable volume ! 
     238            !                             ! ================! 
     239            ! Before scale factor at t-points 
     240            ! ------------------------------- 
    229241            DO jk = 1, jpkm1 
    230                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) 
    238                      ! 
    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) 
    250                      ! 
    251                      ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    252                      vb(ji,jj,jk) = zvf 
    253                      un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
    254                      vn(ji,jj,jk) = va(ji,jj,jk) 
    255                   END DO 
    256                END DO 
    257             END DO 
     242               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   & 
     243                  &              + atfp * (  fse3t_b(:,:,jk) + fse3t_a(:,:,jk)     & 
     244                  &                         - 2.e0 * fse3t_n(:,:,jk)            ) 
     245            ENDDO 
     246            ! Add volume filter correction only at the first level of t-point scale factors 
     247            zec = atfp * rdt / rau0 
     248            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
     249            ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 
     250            zs_t  (:,:) =       e1t(:,:) * e2t(:,:) 
     251            zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:) 
     252            zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:) 
     253            ! 
     254            IF( ln_dynadv_vec ) THEN 
     255               ! Before scale factor at (u/v)-points 
     256               ! ----------------------------------- 
     257               ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
     258               DO jk = 1, jpkm1 
     259                  DO jj = 1, jpjm1 
     260                     DO ji = 1, jpim1 
     261                        zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
     262                        zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
     263                        zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
     264                        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) ) 
     265                        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) ) 
     266                     END DO 
     267                  END DO 
     268               END DO 
     269               ! lateral boundary conditions 
     270               CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) 
     271               CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 
     272               ! Add initial scale factor to scale factor anomaly 
     273               fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 
     274               fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
     275               ! Leap-Frog - Asselin filter and swap: applied on velocity 
     276               ! ----------------------------------- 
     277               DO jk = 1, jpkm1 
     278                  DO jj = 1, jpj 
     279                     DO ji = 1, jpi 
     280                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     281                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     282                        ! 
     283                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
     284                        vb(ji,jj,jk) = zvf 
     285                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
     286                        vn(ji,jj,jk) = va(ji,jj,jk) 
     287                     END DO 
     288                  END DO 
     289               END DO 
     290               ! 
     291            ELSE 
     292               ! Temporary filered scale factor at (u/v)-points (will become before scale factor) 
     293               !----------------------------------------------- 
     294               ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
     295               DO jk = 1, jpkm1 
     296                  DO jj = 1, jpjm1 
     297                     DO ji = 1, jpim1 
     298                        zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
     299                        zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
     300                        zv_t_ijp1        = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
     301                        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) ) 
     302                        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) ) 
     303                     END DO 
     304                  END DO 
     305               END DO 
     306               ! lateral boundary conditions 
     307               CALL lbc_lnk( ze3u_f, 'U', 1. ) 
     308               CALL lbc_lnk( ze3v_f, 'V', 1. ) 
     309               ! Add initial scale factor to scale factor anomaly 
     310               ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 
     311               ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 
     312               ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 
     313               ! -----------------------------------             =========================== 
     314               DO jk = 1, jpkm1 
     315                  DO jj = 1, jpj 
     316                     DO ji = 1, jpim1 
     317                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 
     318                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 
     319                        zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk) 
     320                        zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk) 
     321                        zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 
     322                        zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 
     323                        ! 
     324                        zuf  = ( zue3n + atfp * ( zue3b - 2.e0 * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
     325                        zvf  = ( zve3n + atfp * ( zve3b - 2.e0 * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
     326                        ! 
     327                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
     328                        vb(ji,jj,jk) = zvf 
     329                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
     330                        vn(ji,jj,jk) = va(ji,jj,jk) 
     331                     END DO 
     332                  END DO 
     333               END DO 
     334               fse3u_b(:,:,:) = ze3u_f(:,:,:)                   ! e3u_b <-- filtered scale factor 
     335               fse3v_b(:,:,:) = ze3v_f(:,:,:) 
     336               CALL lbc_lnk( ub, 'U', -1. )                     ! lateral boundary conditions 
     337               CALL lbc_lnk( vb, 'V', -1. ) 
     338            ENDIF 
     339            ! 
    258340         ENDIF 
     341         ! 
    259342      ENDIF 
    260343 
Note: See TracChangeset for help on using the changeset viewer.