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 13295 for NEMO/trunk/src/OCE/ZDF/zdftke.F90 – NEMO

Ignore:
Timestamp:
2020-07-10T20:24:21+02:00 (4 years ago)
Author:
acc
Message:

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r13286 r13295  
    224224      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    225225      !  
    226       DO_2D_00_00 
     226      DO_2D( 0, 0, 0, 0 ) 
    227227         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
    228228      END_2D 
    … …  
    238238      IF( ln_drg ) THEN       !== friction used as top/bottom boundary condition on TKE 
    239239         ! 
    240          DO_2D_00_00 
     240         DO_2D( 0, 0, 0, 0 ) 
    241241            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    242242            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
    … …  
    247247         END_2D 
    248248         IF( ln_isfcav ) THEN       ! top friction 
    249             DO_2D_00_00 
     249            DO_2D( 0, 0, 0, 0 ) 
    250250               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    251251               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
    … …  
    274274         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
    275275         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    276          DO_3DS_11_11( jpkm1, 2, -1 ) 
     276         DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
    277277            zus  = zcof * taum(ji,jj) 
    278278            IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
    279279         END_3D 
    280280         !                               ! finite LC depth 
    281          DO_2D_11_11 
     281         DO_2D( 1, 1, 1, 1 ) 
    282282            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    283283         END_2D 
    284284         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    285          DO_2D_00_00 
     285         DO_2D( 0, 0, 0, 0 ) 
    286286            zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    287287            zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    288288            IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 
    289289         END_2D 
    290          DO_3D_00_00( 2, jpkm1 ) 
     290         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    291291            IF ( zfr_i(ji,jj) /= 0. ) THEN                
    292292               ! vertical velocity due to LC    
    … …  
    310310      ! 
    311311      IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri ) 
    312          DO_3D_00_00( 2, jpkm1 ) 
     312         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    313313            !                             ! local Richardson number 
    314314            IF (rn2b(ji,jj,jk) <= 0.0_wp) then 
    … …  
    322322      ENDIF 
    323323      !          
    324       DO_3D_00_00( 2, jpkm1 ) 
     324      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    325325         zcof   = zfact1 * tmask(ji,jj,jk) 
    326326         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
    … …  
    344344      END_3D 
    345345      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    346       DO_3D_00_00( 3, jpkm1 ) 
     346      DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
    347347         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    348348      END_3D 
    349       DO_2D_00_00 
     349      DO_2D( 0, 0, 0, 0 ) 
    350350         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    351351      END_2D 
    352       DO_3D_00_00( 3, jpkm1 ) 
     352      DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
    353353         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    354354      END_3D 
    355       DO_2D_00_00 
     355      DO_2D( 0, 0, 0, 0 ) 
    356356         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    357357      END_2D 
    358       DO_3DS_00_00( jpk-2, 2, -1 ) 
     358      DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 
    359359         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    360360      END_3D 
    361       DO_3D_00_00( 2, jpkm1 ) 
     361      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    362362         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    363363      END_3D 
    … …  
    371371       
    372372      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    373          DO_3D_00_00( 2, jpkm1 ) 
     373         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    374374            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    375375               &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    376376         END_3D 
    377377      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    378          DO_2D_00_00 
     378         DO_2D( 0, 0, 0, 0 ) 
    379379            jk = nmln(ji,jj) 
    380380            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    … …  
    382382         END_2D 
    383383      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    384          DO_3D_00_00( 2, jpkm1 ) 
     384         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    385385            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    386386            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    … …  
    456456         zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    457457#if ! defined key_si3 && ! defined key_cice 
    458          DO_2D_00_00 
     458         DO_2D( 0, 0, 0, 0 ) 
    459459            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    460460         END_2D 
    … …  
    463463         ! 
    464464         CASE( 0 )                      ! No scaling under sea-ice 
    465             DO_2D_00_00 
     465            DO_2D( 0, 0, 0, 0 ) 
    466466               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
    467467            END_2D 
    468468            ! 
    469469         CASE( 1 )                           ! scaling with constant sea-ice thickness 
    470             DO_2D_00_00 
     470            DO_2D( 0, 0, 0, 0 ) 
    471471               zmxlm(ji,jj,1) =  ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 
    472472            END_2D 
    473473            ! 
    474474         CASE( 2 )                                 ! scaling with mean sea-ice thickness 
    475             DO_2D_00_00 
     475            DO_2D( 0, 0, 0, 0 ) 
    476476#if defined key_si3 
    477477               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 
    … …  
    483483            ! 
    484484         CASE( 3 )                                 ! scaling with max sea-ice thickness 
    485             DO_2D_00_00 
     485            DO_2D( 0, 0, 0, 0 ) 
    486486               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    487487               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
    … …  
    491491#endif 
    492492         ! 
    493          DO_2D_00_00 
     493         DO_2D( 0, 0, 0, 0 ) 
    494494            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    495495         END_2D 
    … …  
    500500 
    501501      ! 
    502       DO_3D_00_00( 2, jpkm1 ) 
     502      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    503503         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    504504         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
    … …  
    515515      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 
    516516      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    517          DO_3D_00_00( 2, jpkm1 ) 
     517         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    518518            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   & 
    519519            &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 
    … …  
    526526         ! 
    527527      CASE ( 1 )           ! bounded by the vertical scale factor 
    528          DO_3D_00_00( 2, jpkm1 ) 
     528         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    529529            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 
    530530            zmxlm(ji,jj,jk) = zemxl 
    … …  
    533533         ! 
    534534      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    535          DO_3D_00_00( 2, jpkm1 ) 
     535         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    536536            zmxlm(ji,jj,jk) =   & 
    537537               &    MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    538538         END_3D 
    539          DO_3DS_00_00( jpkm1, 2, -1 ) 
     539         DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 
    540540            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    541541            zmxlm(ji,jj,jk) = zemxl 
    … …  
    544544         ! 
    545545      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    546          DO_3D_00_00( 2, jpkm1 ) 
     546         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    547547            zmxld(ji,jj,jk) =    & 
    548548               &    MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    549549         END_3D 
    550          DO_3DS_00_00( jpkm1, 2, -1 ) 
     550         DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 
    551551            zmxlm(ji,jj,jk) =   & 
    552552               &    MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    553553         END_3D 
    554          DO_3D_00_00( 2, jpkm1 ) 
     554         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    555555            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    556556            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
    … …  
    564564      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    565565      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    566       DO_3D_00_00( 1, jpkm1 ) 
     566      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    567567         zsqen = SQRT( en(ji,jj,jk) ) 
    568568         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
    … …  
    574574      ! 
    575575      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
    576          DO_3D_00_00( 2, jpkm1 ) 
     576         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    577577            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    578578         END_3D 
Note: See TracChangeset for help on using the changeset viewer.