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 12377 for NEMO/trunk/src/OCE/LDF/ldfdyn.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/LDF/ldfdyn.F90

    r12276 r12377  
    7373 
    7474   !! * Substitutions 
    75 #  include "vectopt_loop_substitute.h90" 
     75#  include "do_loop_substitute.h90" 
    7676   !!---------------------------------------------------------------------- 
    7777   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    115115      !!---------------------------------------------------------------------- 
    116116      ! 
    117       REWIND( numnam_ref ) 
    118117      READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901) 
    119118901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist' ) 
    120119 
    121       REWIND( numnam_cfg ) 
    122120      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 ) 
    123121902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist' ) 
    … …  
    313311            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays') 
    314312            ! 
    315             DO jj = 1, jpj             ! Set local gridscale values 
    316                DO ji = 1, jpi 
    317                   esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2  
    318                   esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2  
    319                END DO 
    320             END DO 
     313            DO_2D_11_11 
     314               esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2  
     315               esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2  
     316            END_2D 
    321317            ! 
    322318         CASE DEFAULT 
    … …  
    339335 
    340336 
    341    SUBROUTINE ldf_dyn( kt ) 
     337   SUBROUTINE ldf_dyn( kt, Kbb ) 
    342338      !!---------------------------------------------------------------------- 
    343339      !!                  ***  ROUTINE ldf_dyn  *** 
    … …  
    357353      !!---------------------------------------------------------------------- 
    358354      INTEGER, INTENT(in) ::   kt   ! time step index 
     355      INTEGER, INTENT(in) ::   Kbb  ! ocean time level indices 
    359356      ! 
    360357      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    371368         IF( ln_dynldf_lap   ) THEN        ! laplacian operator : |u| e /12 = |u/144| e 
    372369            DO jk = 1, jpkm1 
    373                DO jj = 2, jpjm1 
    374                   DO ji = fs_2, fs_jpim1 
    375                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    376                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
    377                      zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    378                      ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2 
    379                   END DO 
    380                END DO 
    381                DO jj = 1, jpjm1 
    382                   DO ji = 1, fs_jpim1 
    383                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    384                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    385                      zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    386                      ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2 
    387                   END DO 
    388                END DO 
     370               DO_2D_00_00 
     371                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     372                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
     373                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
     374                  ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2 
     375               END_2D 
     376               DO_2D_10_10 
     377                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb) 
     378                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb) 
     379                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
     380                  ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2 
     381               END_2D 
    389382            END DO 
    390383         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e 
    391384            DO jk = 1, jpkm1 
    392                DO jj = 2, jpjm1 
    393                   DO ji = fs_2, fs_jpim1 
    394                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    395                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
    396                      zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    397                      ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk) 
    398                   END DO 
    399                END DO 
    400                DO jj = 1, jpjm1 
    401                   DO ji = 1, fs_jpim1 
    402                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    403                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    404                      zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    405                      ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk) 
    406                   END DO 
    407                END DO 
     385               DO_2D_00_00 
     386                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     387                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
     388                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
     389                  ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk) 
     390               END_2D 
     391               DO_2D_10_10 
     392                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb) 
     393                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb) 
     394                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
     395                  ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk) 
     396               END_2D 
    408397            END DO 
    409398         ENDIF 
    … …  
    423412            DO jk = 1, jpkm1 
    424413               ! 
    425                DO jj = 2, jpjm1 
    426                   DO ji = 2, jpim1 
    427                      zdb =   ( ub(ji,jj,jk) * r1_e2u(ji,jj) - ub(ji-1,jj,jk) * r1_e2u(ji-1,jj) ) * r1_e1t(ji,jj) * e2t(ji,jj)  & 
    428                         &  - ( vb(ji,jj,jk) * r1_e1v(ji,jj) - vb(ji,jj-1,jk) * r1_e1v(ji,jj-1) ) * r1_e2t(ji,jj) * e1t(ji,jj) 
    429                      dtensq(ji,jj,jk) = zdb * zdb * tmask(ji,jj,jk) 
    430                   END DO 
    431                END DO 
     414               DO_2D_00_00 
     415                  zdb =    ( uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) -  uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) )  & 
     416                       &                      * r1_e1t(ji,jj) * e2t(ji,jj)                           & 
     417                       & - ( vv(ji,jj,jk,Kbb) * r1_e1v(ji,jj) -  vv(ji,jj-1,jk,Kbb) * r1_e1v(ji,jj-1) )  & 
     418                       &                      * r1_e2t(ji,jj) * e1t(ji,jj) 
     419                  dtensq(ji,jj,jk) = zdb * zdb * tmask(ji,jj,jk) 
     420               END_2D 
    432421               ! 
    433                DO jj = 1, jpjm1 
    434                   DO ji = 1, jpim1 
    435                      zdb =   ( ub(ji,jj+1,jk) * r1_e1u(ji,jj+1) - ub(ji,jj,jk) * r1_e1u(ji,jj) ) * r1_e2f(ji,jj) * e1f(ji,jj)  & 
    436                         &  + ( vb(ji+1,jj,jk) * r1_e2v(ji+1,jj) - vb(ji,jj,jk) * r1_e2v(ji,jj) ) * r1_e1f(ji,jj) * e2f(ji,jj) 
    437                      dshesq(ji,jj,jk) = zdb * zdb * fmask(ji,jj,jk) 
    438                   END DO 
    439                END DO 
     422               DO_2D_10_10 
     423                  zdb =   (  uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) -  uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) )  & 
     424                       &                        * r1_e2f(ji,jj)   * e1f(ji,jj)                       & 
     425                       & + ( vv(ji+1,jj,jk,Kbb) * r1_e2v(ji+1,jj) -  vv(ji,jj,jk,Kbb) * r1_e2v(ji,jj) )  & 
     426                       &                        * r1_e1f(ji,jj)   * e2f(ji,jj) 
     427                  dshesq(ji,jj,jk) = zdb * zdb * fmask(ji,jj,jk) 
     428               END_2D 
    440429               ! 
    441430            END DO 
    … …  
    445434            DO jk = 1, jpkm1 
    446435              ! 
    447                DO jj = 2, jpjm1                                ! T-point value 
    448                   DO ji = fs_2, fs_jpim1 
    449                      ! 
    450                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    451                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
    452                      ! 
    453                      zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2 
    454                      ahmt(ji,jj,jk) = zdelta * SQRT(          dtensq(ji  ,jj,jk) +                         & 
    455                         &                            r1_4 * ( dshesq(ji  ,jj,jk) + dshesq(ji  ,jj-1,jk) +  & 
    456                         &                                     dshesq(ji-1,jj,jk) + dshesq(ji-1,jj-1,jk) ) ) 
    457                      ahmt(ji,jj,jk) = MAX( ahmt(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2 
    458                      ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt) 
    459                      ! 
    460                   END DO 
    461                END DO 
     436               DO_2D_00_00 
     437                  ! 
     438                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     439                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
     440                  ! 
     441                  zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2 
     442                  ahmt(ji,jj,jk) = zdelta * SQRT(          dtensq(ji  ,jj,jk) +                         & 
     443                     &                            r1_4 * ( dshesq(ji  ,jj,jk) + dshesq(ji  ,jj-1,jk) +  & 
     444                     &                                     dshesq(ji-1,jj,jk) + dshesq(ji-1,jj-1,jk) ) ) 
     445                  ahmt(ji,jj,jk) = MAX( ahmt(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2 
     446                  ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt) 
     447                  ! 
     448               END_2D 
    462449               ! 
    463                DO jj = 1, jpjm1                                ! F-point value 
    464                   DO ji = 1, fs_jpim1 
    465                      ! 
    466                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    467                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    468                      ! 
    469                      zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2 
    470                      ahmf(ji,jj,jk) = zdelta * SQRT(          dshesq(ji  ,jj,jk) +                         & 
    471                         &                            r1_4 * ( dtensq(ji  ,jj,jk) + dtensq(ji  ,jj+1,jk) +  & 
    472                         &                                     dtensq(ji+1,jj,jk) + dtensq(ji+1,jj+1,jk) ) ) 
    473                      ahmf(ji,jj,jk) = MAX( ahmf(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2 
    474                      ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt) 
    475                      ! 
    476                   END DO 
    477                END DO 
     450               DO_2D_10_10 
     451                  ! 
     452                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, kbb) * uu(ji  ,jj+1,jk, kbb) + vv(ji+1,jj  ,jk, kbb) * vv(ji+1,jj  ,jk, kbb) 
     453                  zu2pv2_ij    = uu(ji  ,jj  ,jk, kbb) * uu(ji  ,jj  ,jk, kbb) + vv(ji  ,jj  ,jk, kbb) * vv(ji  ,jj  ,jk, kbb) 
     454                  ! 
     455                  zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2 
     456                  ahmf(ji,jj,jk) = zdelta * SQRT(          dshesq(ji  ,jj,jk) +                         & 
     457                     &                            r1_4 * ( dtensq(ji  ,jj,jk) + dtensq(ji  ,jj+1,jk) +  & 
     458                     &                                     dtensq(ji+1,jj,jk) + dtensq(ji+1,jj+1,jk) ) ) 
     459                  ahmf(ji,jj,jk) = MAX( ahmf(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2 
     460                  ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt) 
     461                  ! 
     462               END_2D 
    478463               ! 
    479464            END DO 
    … …  
    486471            !                          ! effective default limits are 1/12 |U|L^3 < B_hm < 1//(32*2dt) L^4 
    487472            DO jk = 1, jpkm1 
    488                DO jj = 2, jpjm1 
    489                   DO ji = fs_2, fs_jpim1 
    490                      ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 
    491                   END DO 
    492                END DO 
    493                DO jj = 1, jpjm1 
    494                   DO ji = 1, fs_jpim1 
    495                      ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 
    496                   END DO 
    497                END DO 
     473               DO_2D_00_00 
     474                  ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 
     475               END_2D 
     476               DO_2D_10_10 
     477                  ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 
     478               END_2D 
    498479            END DO 
    499480            ! 
Note: See TracChangeset for help on using the changeset viewer.