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/tests/CANAL – 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

Location:
NEMO/trunk/tests/CANAL/MY_SRC
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90

    r12740 r13295  
    156156      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature 
    157157      IF ( iom_use("sbt") ) THEN 
    158          DO_2D_11_11 
     158         DO_2D( 1, 1, 1, 1 ) 
    159159            ikbot = mbkt(ji,jj) 
    160160            z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 
    … …  
    166166      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity 
    167167      IF ( iom_use("sbs") ) THEN 
    168          DO_2D_11_11 
     168         DO_2D( 1, 1, 1, 1 ) 
    169169            ikbot = mbkt(ji,jj) 
    170170            z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 
    … …  
    176176         zztmp = rho0 * 0.25 
    177177         z2d(:,:) = 0._wp 
    178          DO_2D_00_00 
     178         DO_2D( 0, 0, 0, 0 ) 
    179179            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   & 
    180180               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   & 
    … …  
    191191      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current 
    192192      IF ( iom_use("sbu") ) THEN 
    193          DO_2D_11_11 
     193         DO_2D( 1, 1, 1, 1 ) 
    194194            ikbot = mbku(ji,jj) 
    195195            z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 
    … …  
    201201      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current 
    202202      IF ( iom_use("sbv") ) THEN 
    203          DO_2D_11_11 
     203         DO_2D( 1, 1, 1, 1 ) 
    204204            ikbot = mbkv(ji,jj) 
    205205            z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 
    … …  
    231231 
    232232      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    233          DO_2D_00_00 
     233         DO_2D( 0, 0, 0, 0 ) 
    234234            zztmp  = ts(ji,jj,1,jp_tem,Kmm) 
    235235            zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 
    … …  
    247247      IF( iom_use("heatc") ) THEN 
    248248         z2d(:,:)  = 0._wp  
    249          DO_3D_11_11( 1, jpkm1 ) 
     249         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    250250            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 
    251251         END_3D 
    … …  
    255255      IF( iom_use("saltc") ) THEN 
    256256         z2d(:,:)  = 0._wp  
    257          DO_3D_11_11( 1, jpkm1 ) 
     257         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    258258            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
    259259         END_3D 
    … …  
    263263      IF( iom_use("salt2c") ) THEN 
    264264         z2d(:,:)  = 0._wp  
    265          DO_3D_11_11( 1, jpkm1 ) 
     265         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    266266            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
    267267         END_3D 
    … …  
    271271      IF ( iom_use("eken") ) THEN 
    272272         z3d(:,:,jpk) = 0._wp  
    273          DO_3D_00_00( 1, jpkm1 ) 
     273         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    274274            zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    275275            z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   & 
    … …  
    287287         z3d(1,:, : ) = 0._wp 
    288288         z3d(:,1, : ) = 0._wp 
    289          DO_3D_00_00( 1, jpkm1 ) 
     289         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    290290            z3d(ji,jj,jk) = 0.25_wp * ( uu(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)  & 
    291291               &                      + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)  & 
    … …  
    298298 
    299299         z2d(:,:)  = 0._wp  
    300          DO_3D_11_11( 1, jpkm1 ) 
     300         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    301301            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 
    302302         END_3D 
    … …  
    310310          
    311311         z3d(:,:,jpk) = 0._wp  
    312          DO_3D_00_00( 1, jpkm1 ) 
     312         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    313313            z3d(ji,jj,jk) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm)    & 
    314314               &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm)  ) * r1_e1e2f(ji,jj) 
    … …  
    317317         CALL iom_put( "relvor", z3d )                  ! relative vorticity 
    318318 
    319          DO_3D_11_11( 1, jpkm1 ) 
     319         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    320320            z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk)  
    321321         END_3D 
    322322         CALL iom_put( "absvor", z3d )                  ! absolute vorticity 
    323323 
    324          DO_3D_00_00( 1, jpkm1 ) 
     324         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    325325            ze3  = (  e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
    326326               &    + e3t(ji,jj  ,jk,Kmm)*tmask(ji,jj  ,jk) + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
    … …  
    348348      IF( iom_use("u_heattr") ) THEN 
    349349         z2d(:,:) = 0._wp  
    350          DO_3D_00_00( 1, jpkm1 ) 
     350         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    351351            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
    352352         END_3D 
    … …  
    357357      IF( iom_use("u_salttr") ) THEN 
    358358         z2d(:,:) = 0.e0  
    359          DO_3D_00_00( 1, jpkm1 ) 
     359         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    360360            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
    361361         END_3D 
    … …  
    375375      IF( iom_use("v_heattr") ) THEN 
    376376         z2d(:,:) = 0.e0  
    377          DO_3D_00_00( 1, jpkm1 ) 
     377         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    378378            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
    379379         END_3D 
    … …  
    384384      IF( iom_use("v_salttr") ) THEN 
    385385         z2d(:,:) = 0._wp  
    386          DO_3D_00_00( 1, jpkm1 ) 
     386         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    387387            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
    388388         END_3D 
    … …  
    393393      IF( iom_use("tosmint") ) THEN 
    394394         z2d(:,:) = 0._wp 
    395          DO_3D_00_00( 1, jpkm1 ) 
     395         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    396396            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
    397397         END_3D 
    … …  
    401401      IF( iom_use("somint") ) THEN 
    402402         z2d(:,:)=0._wp 
    403          DO_3D_00_00( 1, jpkm1 ) 
     403         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    404404            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    405405         END_3D 

  • NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90

    r13286 r13295  
    190190      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    191191      gdepw(:,:,1,Kbb) = 0.0_wp 
    192       DO_3D_11_11( 2, jpk ) 
     192      DO_3D( 1, 1, 1, 1, 2, jpk ) 
    193193         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    194194         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    … …  
    238238         ENDIF 
    239239         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    240             DO_2D_11_11 
     240            DO_2D( 1, 1, 1, 1 ) 
    241241!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default 
    242242               IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    … …  
    407407         zwu(:,:) = 0._wp 
    408408         zwv(:,:) = 0._wp 
    409          DO_3D_10_10( 1, jpkm1 ) 
     409         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    410410            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    411411               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    … …  
    415415            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    416416         END_3D 
    417          DO_2D_11_11 
     417         DO_2D( 1, 1, 1, 1 ) 
    418418            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    419419            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    420420         END_2D 
    421          DO_3D_00_00( 1, jpkm1 ) 
     421         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    422422            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    423423               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    … …  
    647647      gdepw(:,:,1,Kmm) = 0.0_wp 
    648648      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    649       DO_3D_11_11( 2, jpk ) 
     649      DO_3D( 1, 1, 1, 1, 2, jpk ) 
    650650        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    651651                                                           ! 1 for jk = mikt 
    … …  
    702702         ! 
    703703      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    704          DO_3D_10_10( 1, jpk ) 
     704         DO_3D( 1, 0, 1, 0, 1, jpk ) 
    705705            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
    706706               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    … …  
    711711         ! 
    712712      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    713          DO_3D_10_10( 1, jpk ) 
     713         DO_3D( 1, 0, 1, 0, 1, jpk ) 
    714714            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
    715715               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    … …  
    720720         ! 
    721721      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    722          DO_3D_10_10( 1, jpk ) 
     722         DO_3D( 1, 0, 1, 0, 1, jpk ) 
    723723            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    724724               &                       *    r1_e1e2f(ji,jj)                                                  & 
    … …  
    887887                  ssh(:,:,Kbb) = -ssh_ref 
    888888 
    889                   DO_2D_11_11 
     889                  DO_2D( 1, 1, 1, 1 ) 
    890890                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    891891                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    … …  
    903903               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    904904 
    905                DO_2D_11_11 
     905               DO_2D( 1, 1, 1, 1 ) 
    906906                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    907907                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 

  • NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90

    r12740 r13295  
    156156            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    157157               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
    158                   DO_3D_00_00( 2, jpkm1 ) 
     158                  DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    159159                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
    160160                  END_3D 
    161161               ELSE                          ! standard or triad iso-neutral operator 
    162                   DO_3D_00_00( 2, jpkm1 ) 
     162                  DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    163163                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
    164164                  END_3D 
    … …  
    168168            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    169169            IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection 
    170                DO_3D_00_00( 1, jpkm1 ) 
     170               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    171171                  zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm) 
    172172                  zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    … …  
    177177               END_3D 
    178178            ELSE 
    179                DO_3D_00_00( 1, jpkm1 ) 
     179               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    180180                  zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm) 
    181181                  zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    … …  
    203203            !   used as a work space array: its value is modified. 
    204204            ! 
    205             DO_2D_00_00 
     205            DO_2D( 0, 0, 0, 0 ) 
    206206               zwt(ji,jj,1) = zwd(ji,jj,1) 
    207207            END_2D 
    208             DO_3D_00_00( 2, jpkm1 ) 
     208            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    209209               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 
    210210            END_3D 
    … …  
    212212         ENDIF  
    213213         !          
    214          DO_2D_00_00 
     214         DO_2D( 0, 0, 0, 0 ) 
    215215            pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
    216216         END_2D 
    217          DO_3D_00_00( 2, jpkm1 ) 
     217         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    218218            zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side 
    219219            pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 
    220220         END_3D 
    221221         ! 
    222          DO_2D_00_00 
     222         DO_2D( 0, 0, 0, 0 ) 
    223223            pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
    224224         END_2D 
    225          DO_3DS_00_00( jpk-2, 1, -1 ) 
     225         DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 
    226226            pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   & 
    227227               &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 

  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_hgr.F90

    r13286 r13295  
    9090#endif 
    9191          
    92       DO_2D_11_11          
     92      DO_2D( 1, 1, 1, 1 )          
    9393         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
    9494         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 

  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

    r12740 r13295  
    166166         pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 
    167167         DO jl=1, jpnj 
    168             DO_2D_00_00 
     168            DO_2D( 0, 0, 0, 0 ) 
    169169               pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 
    170170            END_2D 
    … …  
    183183      CASE(4)    ! geostrophic zonal pulse 
    184184    
    185          DO_2D_11_11 
     185         DO_2D( 1, 1, 1, 1 ) 
    186186            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
    187187               zdu = rn_uzonal 
    … …  
    217217         zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
    218218         ! 
    219          DO_2D_11_11 
     219         DO_2D( 1, 1, 1, 1 ) 
    220220            zx = glamt(ji,jj) * 1.e3 
    221221            zy = gphit(ji,jj) * 1.e3 
    … …  
    248248         ! velocities: 
    249249         za = 2._wp * zP0 / zlambda**2 
    250          DO_2D_00_00 
     250         DO_2D( 0, 0, 0, 0 ) 
    251251            zx = glamu(ji,jj) * 1.e3 
    252252            zy = gphiu(ji,jj) * 1.e3 
    … …  
    263263         END_2D 
    264264         ! 
    265          DO_2D_00_00 
     265         DO_2D( 0, 0, 0, 0 ) 
    266266            zx = glamv(ji,jj) * 1.e3 
    267267            zy = gphiv(ji,jj) * 1.e3 
Note: See TracChangeset for help on using the changeset viewer.