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 14072 for NEMO/trunk/src/OCE/DYN/dynvor.F90 – NEMO

Ignore:
Timestamp:
2020-12-04T08:48:38+01:00 (3 years ago)
Author:
laurent
Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/DYN/dynvor.F90

    r14053 r14072  
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    1616   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
    17    !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity  
     17   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity 
    1818   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory 
    1919   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 
     
    7474   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 5   ! MIX scheme 
    7575 
    76    INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity  
     76   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
    7777   !                               ! associated indices: 
    7878   INTEGER, PUBLIC, PARAMETER ::   np_COR = 1         ! Coriolis (planetary) 
     
    8383 
    8484   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    85    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
     85   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       - 
    8686   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation 
    8787   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       - 
    8888   ! 
    8989   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   e3f_0vor   ! e3f used in EEN, ENE and ENS cases (key_qco only) 
    90     
     90 
    9191   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
    9292   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8 
    9393   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12 
    94     
     94 
    9595   !! * Substitutions 
    9696#  include "do_loop_substitute.h90" 
     
    111111      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend 
    112112      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    113       !!               and planetary vorticity trends) and send them to trd_dyn  
     113      !!               and planetary vorticity trends) and send them to trd_dyn 
    114114      !!               for futher diagnostics (l_trddyn=T) 
    115115      !!---------------------------------------------------------------------- 
     
    163163                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    164164            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
    165                              CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend  
     165                             CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    166166            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
    167167                             CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     
    218218      !!                  ***  ROUTINE vor_enT  *** 
    219219      !! 
    220       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     220      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    221221      !!      the general trend of the momentum equation. 
    222222      !! 
    223       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     223      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    224224      !!       and t-point evaluation of vorticity (planetary and relative). 
    225225      !!       conserves the horizontal kinetic energy. 
    226       !!         The general trend of momentum is increased due to the vorticity  
     226      !!         The general trend of momentum is increased due to the vorticity 
    227227      !!       term which is given by: 
    228228      !!          voru = 1/bu  mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t  mj[vn] ] 
     
    260260                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    261261            END_2D 
    262             IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity  
     262            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity 
    263263               DO_2D( 1, 0, 1, 0 ) 
    264264                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
     
    314314               ! 
    315315            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    & 
    316                &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   &  
    317                &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   )  
     316               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
     317               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
    318318         END_2D 
    319319         !                                             ! =============== 
     
    332332      !!                  ***  ROUTINE vor_ene  *** 
    333333      !! 
    334       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     334      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    335335      !!      the general trend of the momentum equation. 
    336336      !! 
    337       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     337      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    338338      !!       and the Sadourny (1975) flux form formulation : conserves the 
    339339      !!       horizontal kinetic energy. 
    340       !!         The general trend of momentum is increased due to the vorticity  
     340      !!         The general trend of momentum is increased due to the vorticity 
    341341      !!       term which is given by: 
    342342      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ] 
     
    371371         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    372372         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    373             zwz(:,:) = ff_f(:,:)  
     373            zwz(:,:) = ff_f(:,:) 
    374374         CASE ( np_RVO )                           !* relative vorticity 
    375375            DO_2D( 1, 0, 1, 0 ) 
     
    447447            zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    448448            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    449             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     449            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    450450         END_2D 
    451451         !                                             ! =============== 
     
    497497         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    498498         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    499             zwz(:,:) = ff_f(:,:)  
     499            zwz(:,:) = ff_f(:,:) 
    500500         CASE ( np_RVO )                           !* relative vorticity 
    501501            DO_2D( 1, 0, 1, 0 ) 
     
    586586      !!                ***  ROUTINE vor_een  *** 
    587587      !! 
    588       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     588      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    589589      !!      the general trend of the momentum equation. 
    590590      !! 
    591       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    592       !!      and the Arakawa and Lamb (1980) flux form formulation : conserves  
     591      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     592      !!      and the Arakawa and Lamb (1980) flux form formulation : conserves 
    593593      !!      both the horizontal kinetic energy and the potential enstrophy 
    594594      !!      when horizontal divergence is zero (see the NEMO documentation) 
     
    684684            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    685685               DO_2D( 1, 0, 1, 0 ) 
    686                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     686                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    687687               END_2D 
    688688            ENDIF 
     
    735735      !!                ***  ROUTINE vor_eeT  *** 
    736736      !! 
    737       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     737      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    738738      !!      the general trend of the momentum equation. 
    739739      !! 
    740       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    741       !!      and the Arakawa and Lamb (1980) vector form formulation using  
     740      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     741      !!      and the Arakawa and Lamb (1980) vector form formulation using 
    742742      !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een). 
    743       !!      The change consists in  
     743      !!      The change consists in 
    744744      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs). 
    745745      !! 
     
    758758      REAL(wp) ::   zua, zva       ! local scalars 
    759759      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    760       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy  
     760      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy 
    761761      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    762762      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
     
    803803            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    804804               DO_2D( 1, 0, 1, 0 ) 
    805                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     805                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    806806               END_2D 
    807807            ENDIF 
     
    916916      ! 
    917917      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
    918       !                       
     918      ! 
    919919      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot) 
    920920      ncor = np_COR                       ! planetary vorticity 
     
    925925         ntot = np_COR        !     -         - 
    926926      CASE( np_VEC_c2  ) 
    927          IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
     927         IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity' 
    928928         nrvm = np_RVO        ! relative vorticity 
    929          ntot = np_CRV        ! relative + planetary vorticity          
     929         ntot = np_CRV        ! relative + planetary vorticity 
    930930      CASE( np_FLX_c2 , np_FLX_ubs  ) 
    931931         IF(lwp) WRITE(numout,*) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term' 
     
    971971                  &  + tmask(ji,jj  ,jk) +tmask(ji+1,jj  ,jk)  ) 
    972972               ! 
    973                IF( zmsk /= 0._wp ) THEN  
     973               IF( zmsk /= 0._wp ) THEN 
    974974                  e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
    975975                     &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     
    997997         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)' 
    998998         CASE( np_MIX )   ;   WRITE(numout,*) '   ==>>>   mixed enstrophy/energy conserving scheme (MIX)' 
    999          END SELECT          
     999         END SELECT 
    10001000      ENDIF 
    10011001      ! 
Note: See TracChangeset for help on using the changeset viewer.