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/zdfiwm.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/zdfiwm.F90

    r13286 r13295  
    143143      ! Set to zero the 1st and last vertical levels of appropriate variables 
    144144      IF( iom_use("emix_iwm") ) THEN 
    145          DO_2D_00_00 
     145         DO_2D( 0, 0, 0, 0 ) 
    146146            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
    147147         END_2D 
    … …  
    150150      ENDIF 
    151151      IF( iom_use("av_ratio") ) THEN 
    152          DO_2D_00_00 
     152         DO_2D( 0, 0, 0, 0 ) 
    153153            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
    154154         END_2D 
    … …  
    157157      ENDIF 
    158158      IF( iom_use("av_wave") ) THEN 
    159          DO_2D_00_00 
     159         DO_2D( 0, 0, 0, 0 ) 
    160160            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
    161161         END_2D 
    … …  
    170170      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    171171      !                                                 using an exponential decay from the seafloor. 
    172       DO_2D_00_00 
     172      DO_2D( 0, 0, 0, 0 ) 
    173173         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    174174         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
    … …  
    176176      END_2D 
    177177!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    178       DO_3D_00_00( 2, jpkm1 ) 
     178      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    179179         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    180180            zemx_iwm(ji,jj,jk) = 0._wp 
    … …  
    196196      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    197197         ! 
    198          DO_2D_00_00 
     198         DO_2D( 0, 0, 0, 0 ) 
    199199            zfact(ji,jj) = 0._wp 
    200200         END_2D 
    201          DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     201         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    202202            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    203203         END_3D 
    204204         ! 
    205          DO_2D_00_00 
     205         DO_2D( 0, 0, 0, 0 ) 
    206206            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    207207         END_2D 
    208208         ! 
    209          DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     209         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
    210210            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    211211         END_3D 
    … …  
    213213      CASE ( 2 )               ! Dissipation scales as N^2 
    214214         ! 
    215          DO_2D_00_00 
     215         DO_2D( 0, 0, 0, 0 ) 
    216216            zfact(ji,jj) = 0._wp 
    217217         END_2D 
    218          DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     218         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    219219            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    220220         END_3D 
    221221         ! 
    222          DO_2D_00_00 
     222         DO_2D( 0, 0, 0, 0 ) 
    223223            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    224224         END_2D 
    225225         ! 
    226          DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     226         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
    227227            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    228228         END_3D 
    … …  
    233233      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    234234      ! 
    235       DO_2D_00_00 
     235      DO_2D( 0, 0, 0, 0 ) 
    236236         zwkb(ji,jj,1) = 0._wp 
    237237      END_2D 
    238       DO_3D_00_00( 2, jpkm1 ) 
     238      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    239239         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    240240      END_3D 
    241       DO_2D_00_00 
     241      DO_2D( 0, 0, 0, 0 ) 
    242242         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
    243243      END_2D 
    244244      ! 
    245       DO_3D_00_00( 2, jpkm1 ) 
     245      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    246246         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    247247            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    248248      END_3D 
    249       DO_2D_00_00 
     249      DO_2D( 0, 0, 0, 0 ) 
    250250         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
    251251      END_2D 
    252252      ! 
    253       DO_3D_00_00( 2, jpkm1 ) 
     253      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    254254         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    255255            zweight(ji,jj,jk) = 0._wp 
    … …  
    260260      END_3D 
    261261      ! 
    262       DO_2D_00_00 
     262      DO_2D( 0, 0, 0, 0 ) 
    263263         zfact(ji,jj) = 0._wp 
    264264      END_2D 
    265       DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     265      DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    266266         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    267267      END_3D 
    268268      ! 
    269       DO_2D_00_00 
     269      DO_2D( 0, 0, 0, 0 ) 
    270270         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    271271      END_2D 
    272272      ! 
    273       DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     273      DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
    274274         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
    275275            &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
    … …  
    279279!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    280280      ! Calculate molecular kinematic viscosity 
    281       DO_3D_00_00( 1, jpkm1 ) 
     281      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    282282         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
    283283            &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  & 
    284284            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
    285285      END_3D 
    286       DO_3D_00_00( 2, jpkm1 ) 
     286      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    287287         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    288288      END_3D 
    … …  
    290290      ! 
    291291      ! Calculate turbulence intensity parameter Reb 
    292       DO_3D_00_00( 2, jpkm1 ) 
     292      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    293293         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    294294      END_3D 
    295295      ! 
    296296      ! Define internal wave-induced diffusivity 
    297       DO_3D_00_00( 2, jpkm1 ) 
     297      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    298298         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    299299      END_3D 
    300300      ! 
    301301      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
    302          DO_3D_00_00( 2, jpkm1 ) 
     302         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    303303            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    304304               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
    … …  
    309309      ENDIF 
    310310      ! 
    311       DO_3D_00_00( 2, jpkm1 )          ! Bound diffusivity by molecular value and 100 cm2/s 
     311      DO_3D( 0, 0, 0, 0, 2, jpkm1 )          ! Bound diffusivity by molecular value and 100 cm2/s 
    312312         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    313313      END_3D 
    … …  
    316316         zztmp = 0._wp 
    317317!!gm used of glosum 3D.... 
    318          DO_3D_00_00( 2, jpkm1 ) 
     318         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    319319            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   & 
    320320               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    … …  
    338338      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
    339339         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    340          DO_3D_00_00( 2, jpkm1 ) 
     340         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    341341            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    342342            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
    … …  
    347347         END_3D 
    348348         CALL iom_put( "av_ratio", zav_ratio ) 
    349          DO_3D_00_00( 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
     349         DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    350350            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    351351            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    … …  
    354354         ! 
    355355      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing 
    356          DO_3D_00_00( 2, jpkm1 ) 
     356         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    357357            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 
    358358            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    … …  
    369369         ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
    370370         ! Initialisation for iom_put 
    371          DO_2D_00_00 
     371         DO_2D( 0, 0, 0, 0 ) 
    372372            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
    373373         END_2D 
    … …  
    377377         z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp 
    378378 
    379          DO_3D_00_00( 2, jpkm1 ) 
     379         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    380380            z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 
    381381         END_3D 
    382          DO_2D_00_00 
     382         DO_2D( 0, 0, 0, 0 ) 
    383383            z2d(ji,jj) = 0._wp 
    384384         END_2D 
    385          DO_3D_00_00( 2, jpkm1 )  
     385         DO_3D( 0, 0, 0, 0, 2, jpkm1 )  
    386386            z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk) 
    387387         END_3D 
    388          DO_2D_00_00 
     388         DO_2D( 0, 0, 0, 0 ) 
    389389            z2d(ji,jj) = rho0 * z2d(ji,jj) 
    390390         END_2D 
Note: See TracChangeset for help on using the changeset viewer.