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 13470 – NEMO

Changeset 13470


Ignore:
Timestamp:
2020-09-15T12:56:56+02:00 (4 years ago)
Author:
smasson
Message:

r4_trunk: second change of DO loops for routines to be merged, see #2523

Location:
NEMO/branches/2020/temporary_r4_trunk
Files:
30 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90

    r13469 r13470  
    122122      ! 
    123123      DO jl = 1, jpl 
    124          DO_2D_11_11 
     124         DO_2D( 1, 1, 1, 1 ) 
    125125            ! 
    126126            !---------------------------------------------! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90

    r13469 r13470  
    9292         zzc = rhoi * r1_rdtice 
    9393         DO jl = 1, jpl 
    94             DO_2D_11_11 
     94            DO_2D( 1, 1, 1, 1 ) 
    9595               zsal = sv_i(ji,jj,jl) 
    9696               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  ) 
    … …  
    105105      !                             !----------------------------------------------------- 
    106106      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! 
    107          DO_2D_00_00 
     107         DO_2D( 0, 0, 0, 0 ) 
    108108            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
    109109               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90

    r13469 r13470  
    366366      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    367367      DO jl = 1, jpl 
    368          DO_2D_11_11 
     368         DO_2D( 1, 1, 1, 1 ) 
    369369            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    370370               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
    … …  
    381381      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    382382      DO jl = 1, jpl 
    383          DO_2D_11_11 
     383         DO_2D( 1, 1, 1, 1 ) 
    384384            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    385385               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
    … …  
    396396      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    397397      DO jl = 1, jpl 
    398          DO_3D_11_11( 1, nlay_i ) 
     398         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    399399            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    400400            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    … …  
    410410      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
    411411      DO jl = 1, jpl 
    412          DO_3D_11_11( 1, nlay_i ) 
     412         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    413413            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    414414            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    … …  
    424424      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
    425425      jl = jpl  
    426       DO_2D_11_11 
     426      DO_2D( 1, 1, 1, 1 ) 
    427427         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
    428428            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
    … …  
    436436      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
    437437      jl = 1  
    438       DO_2D_11_11 
     438      DO_2D( 1, 1, 1, 1 ) 
    439439         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
    440440            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
    … …  
    447447      ialert_id = ialert_id + 1 ! reference number of this alert 
    448448      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
    449       DO_2D_11_11 
     449      DO_2D( 1, 1, 1, 1 ) 
    450450         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
    451451            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
    … …  
    458458      ialert_id = ialert_id + 1 ! reference number of this alert 
    459459      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
    460       DO_2D_11_11 
     460      DO_2D( 1, 1, 1, 1 ) 
    461461         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
    462462            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
    … …  
    469469      ialert_id = ialert_id + 1 ! reference number of this alert 
    470470      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
    471       DO_2D_11_11 
     471      DO_2D( 1, 1, 1, 1 ) 
    472472         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
    473473            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90

    r13469 r13470  
    127127         ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 
    128128         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s  
    129          DO_2D_11_11 
     129         DO_2D( 1, 1, 1, 1 ) 
    130130            zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 
    131131            zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 
    … …  
    156156 
    157157            ALLOCATE( zdivu_i(jpi,jpj) ) 
    158             DO_2D_00_00 
     158            DO_2D( 0, 0, 0, 0 ) 
    159159               zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    160160                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90

    r13469 r13470  
    110110      END WHERE 
    111111      DO jl = 1, jpl 
    112          DO_2D_00_00 
     112         DO_2D( 0, 0, 0, 0 ) 
    113113            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    114114               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    … …  
    143143      END DO 
    144144      DO jl = 1, jpl 
    145          DO_3D_00_00( 1, nlay_i ) 
     145         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
    146146            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
    147147               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
    … …  
    151151      END DO 
    152152      DO jl = 1, jpl 
    153          DO_3D_00_00( 1, nlay_s ) 
     153         DO_3D( 0, 0, 0, 0, 1, nlay_s ) 
    154154            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
    155155               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
    … …  
    307307         ! derive open water from ice concentration 
    308308         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    309          DO_2D_00_00 
     309         DO_2D( 0, 0, 0, 0 ) 
    310310            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water 
    311311               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    … …  
    363363         ! 
    364364         ! Limitation of moments.                                            
    365          DO_2D_00_11 
     365         DO_2D( 0, 0, 1, 1 ) 
    366366            !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    367367            psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 
    … …  
    383383 
    384384         !  Calculate fluxes and moments between boxes i<-->i+1               
    385          DO_2D_00_11 
     385         DO_2D( 0, 0, 1, 1 ) 
    386386            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    387387            zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
    … …  
    408408         END_2D 
    409409 
    410          DO_2D_00_10 
     410         DO_2D( 0, 0, 1, 0 ) 
    411411            zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
    412412            zalg  (ji,jj) = zalf 
    … …  
    427427         END_2D 
    428428 
    429          DO_2D_00_00 
     429         DO_2D( 0, 0, 0, 0 ) 
    430430            zbt  =       zbet(ji-1,jj) 
    431431            zbt1 = 1.0 - zbet(ji-1,jj) 
    … …  
    441441 
    442442         !   Put the temporary moments into appropriate neighboring boxes.     
    443          DO_2D_00_00 
     443         DO_2D( 0, 0, 0, 0 ) 
    444444            zbt  =       zbet(ji-1,jj) 
    445445            zbt1 = 1.0 - zbet(ji-1,jj) 
    … …  
    461461         END_2D 
    462462 
    463          DO_2D_00_00 
     463         DO_2D( 0, 0, 0, 0 ) 
    464464            zbt  =       zbet(ji,jj) 
    465465            zbt1 = 1.0 - zbet(ji,jj) 
    … …  
    520520         ! 
    521521         ! Limitation of moments. 
    522          DO_2D_11_00 
     522         DO_2D( 1, 1, 0, 0 ) 
    523523            !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    524524            psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
    … …  
    540540  
    541541         !  Calculate fluxes and moments between boxes j<-->j+1               
    542          DO_2D_11_00 
     542         DO_2D( 1, 1, 0, 0 ) 
    543543            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    544544            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
    … …  
    565565         END_2D 
    566566         ! 
    567          DO_2D_10_00 
     567         DO_2D( 1, 0, 0, 0 ) 
    568568            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
    569569            zalg  (ji,jj) = zalf 
    … …  
    585585 
    586586         !  Readjust moments remaining in the box.  
    587          DO_2D_00_00 
     587         DO_2D( 0, 0, 0, 0 ) 
    588588            zbt  =         zbet(ji,jj-1) 
    589589            zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    … …  
    599599 
    600600         !   Put the temporary moments into appropriate neighboring boxes.     
    601          DO_2D_00_00 
     601         DO_2D( 0, 0, 0, 0 ) 
    602602            zbt  =       zbet(ji,jj-1) 
    603603            zbt1 = 1.0 - zbet(ji,jj-1) 
    … …  
    620620         END_2D 
    621621 
    622          DO_2D_00_00 
     622         DO_2D( 0, 0, 0, 0 ) 
    623623            zbt  =       zbet(ji,jj) 
    624624            zbt1 = 1.0 - zbet(ji,jj) 
    … …  
    679679      ! 
    680680      DO jl = 1, jpl 
    681          DO_2D_11_11 
     681         DO_2D( 1, 1, 1, 1 ) 
    682682            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    683683               ! 
    … …  
    726726      !                                           ! -- check e_i/v_i -- ! 
    727727      DO jl = 1, jpl 
    728          DO_3D_11_11( 1, nlay_i ) 
     728         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    729729            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    730730               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    740740      !                                           ! -- check e_s/v_s -- ! 
    741741      DO jl = 1, jpl 
    742          DO_3D_11_11( 1, nlay_s ) 
     742         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    743743            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    744744               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    783783      ! -- check snow load -- ! 
    784784      DO jl = 1, jpl 
    785          DO_2D_11_11 
     785         DO_2D( 1, 1, 1, 1 ) 
    786786            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    787787               ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90

    r13469 r13470  
    114114      END WHERE 
    115115      DO jl = 1, jpl 
    116          DO_2D_00_00 
     116         DO_2D( 0, 0, 0, 0 ) 
    117117            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    118118               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    … …  
    147147      END DO 
    148148      DO jl = 1, jpl 
    149          DO_3D_00_00( 1, nlay_i ) 
     149         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
    150150            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
    151151               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
    … …  
    155155      END DO 
    156156      DO jl = 1, jpl 
    157          DO_3D_00_00( 1, nlay_s ) 
     157         DO_3D( 0, 0, 0, 0, 1, nlay_s ) 
    158158            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
    159159               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
    … …  
    191191      ! 
    192192      ! --- define velocity for advection: u*grad(H) --- ! 
    193       DO_2D_00_00 
     193      DO_2D( 0, 0, 0, 0 ) 
    194194         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
    195195         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
    … …  
    224224            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )  
    225225            DO jl = 1, jpl 
    226                DO_2D_10_10 
     226               DO_2D( 1, 0, 1, 0 ) 
    227227                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
    228228                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
    … …  
    380380         !== Open water area ==! 
    381381         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    382          DO_2D_00_00 
     382         DO_2D( 0, 0, 0, 0 ) 
    383383            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &  
    384384               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    … …  
    490490      IF( pamsk == 0._wp ) THEN 
    491491         DO jl = 1, jpl 
    492             DO_2D_10_10 
     492            DO_2D( 1, 0, 1, 0 ) 
    493493               IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 
    494494                  zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj) 
    … …  
    512512         ! thus we calculate the upstream solution and apply a limiter again 
    513513         DO jl = 1, jpl 
    514             DO_2D_00_00 
     514            DO_2D( 0, 0, 0, 0 ) 
    515515               ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 
    516516               ! 
    … …  
    533533      IF( PRESENT( pua_ho ) ) THEN 
    534534         DO jl = 1, jpl 
    535             DO_2D_10_10 
     535            DO_2D( 1, 0, 1, 0 ) 
    536536               pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
    537537               pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
    … …  
    543543      ! --------------------------------- 
    544544      DO jl = 1, jpl 
    545          DO_2D_00_00 
     545         DO_2D( 0, 0, 0, 0 ) 
    546546            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )   
    547547            ! 
    … …  
    577577         ! 
    578578         DO jl = 1, jpl 
    579             DO_2D_10_10 
     579            DO_2D( 1, 0, 1, 0 ) 
    580580               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    581581               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    … …  
    588588            ! 
    589589            DO jl = 1, jpl              !-- flux in x-direction 
    590                DO_2D_10_10 
     590               DO_2D( 1, 0, 1, 0 ) 
    591591                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    592592               END_2D 
    … …  
    594594            ! 
    595595            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    596                DO_2D_00_00 
     596               DO_2D( 0, 0, 0, 0 ) 
    597597                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
    598598                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    604604            ! 
    605605            DO jl = 1, jpl              !-- flux in y-direction 
    606                DO_2D_10_10 
     606               DO_2D( 1, 0, 1, 0 ) 
    607607                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    608608               END_2D 
    … …  
    612612            ! 
    613613            DO jl = 1, jpl              !-- flux in y-direction 
    614                DO_2D_10_10 
     614               DO_2D( 1, 0, 1, 0 ) 
    615615                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    616616               END_2D 
    … …  
    618618            ! 
    619619            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    620                DO_2D_00_00 
     620               DO_2D( 0, 0, 0, 0 ) 
    621621                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    622622                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    628628            ! 
    629629            DO jl = 1, jpl              !-- flux in x-direction 
    630                DO_2D_10_10 
     630               DO_2D( 1, 0, 1, 0 ) 
    631631                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
    632632               END_2D 
    … …  
    638638      ! 
    639639      DO jl = 1, jpl                    !-- after tracer with upstream scheme 
    640          DO_2D_00_00 
     640         DO_2D( 0, 0, 0, 0 ) 
    641641            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
    642642               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
    … …  
    677677         ! 
    678678         DO jl = 1, jpl 
    679             DO_2D_10_10 
     679            DO_2D( 1, 0, 1, 0 ) 
    680680               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
    681681               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    … …  
    695695            ! 
    696696            DO jl = 1, jpl              !-- flux in x-direction 
    697                DO_2D_10_10 
     697               DO_2D( 1, 0, 1, 0 ) 
    698698                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    699699               END_2D 
    … …  
    702702 
    703703            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    704                DO_2D_00_00 
     704               DO_2D( 0, 0, 0, 0 ) 
    705705                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
    706706                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    712712 
    713713            DO jl = 1, jpl              !-- flux in y-direction 
    714                DO_2D_10_10 
     714               DO_2D( 1, 0, 1, 0 ) 
    715715                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    716716               END_2D 
    … …  
    721721            ! 
    722722            DO jl = 1, jpl              !-- flux in y-direction 
    723                DO_2D_10_10 
     723               DO_2D( 1, 0, 1, 0 ) 
    724724                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    725725               END_2D 
    … …  
    728728            ! 
    729729            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    730                DO_2D_00_00 
     730               DO_2D( 0, 0, 0, 0 ) 
    731731                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    732732                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    738738            ! 
    739739            DO jl = 1, jpl              !-- flux in x-direction 
    740                DO_2D_10_10 
     740               DO_2D( 1, 0, 1, 0 ) 
    741741                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    742742               END_2D 
    … …  
    786786         !                                                        !--  advective form update in zpt  --! 
    787787         DO jl = 1, jpl 
    788             DO_2D_00_00 
     788            DO_2D( 0, 0, 0, 0 ) 
    789789               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
    790790                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    813813         !                                                        !--  advective form update in zpt  --! 
    814814         DO jl = 1, jpl 
    815             DO_2D_00_00 
     815            DO_2D( 0, 0, 0, 0 ) 
    816816               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
    817817                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    895895         !         
    896896         DO jl = 1, jpl 
    897             DO_2D_10_10 
     897            DO_2D( 1, 0, 1, 0 ) 
    898898               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    899899                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    … …  
    904904         ! 
    905905         DO jl = 1, jpl 
    906             DO_2D_10_10 
     906            DO_2D( 1, 0, 1, 0 ) 
    907907               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    908908               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    914914         ! 
    915915         DO jl = 1, jpl 
    916             DO_2D_10_10 
     916            DO_2D( 1, 0, 1, 0 ) 
    917917               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    918918               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    928928         ! 
    929929         DO jl = 1, jpl 
    930             DO_2D_10_10 
     930            DO_2D( 1, 0, 1, 0 ) 
    931931               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    932932               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    942942         ! 
    943943         DO jl = 1, jpl 
    944             DO_2D_10_10 
     944            DO_2D( 1, 0, 1, 0 ) 
    945945               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    946946               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    963963      IF( ll_neg ) THEN 
    964964         DO jl = 1, jpl 
    965             DO_2D_10_10 
     965            DO_2D( 1, 0, 1, 0 ) 
    966966               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    967967                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    973973      !                                                     !-- High order flux in i-direction  --! 
    974974      DO jl = 1, jpl 
    975          DO_2D_10_10 
     975         DO_2D( 1, 0, 1, 0 ) 
    976976            pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 
    977977         END_2D 
    … …  
    10061006      !                                                     !--  Laplacian in j-direction  --! 
    10071007      DO jl = 1, jpl 
    1008          DO_2D_10_00 
     1008         DO_2D( 1, 0, 0, 0 ) 
    10091009            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10101010         END_2D 
    1011          DO_2D_00_00 
     1011         DO_2D( 0, 0, 0, 0 ) 
    10121012            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10131013         END_2D 
    … …  
    10171017      !                                                     !--  BiLaplacian in j-direction  --! 
    10181018      DO jl = 1, jpl 
    1019          DO_2D_10_00 
     1019         DO_2D( 1, 0, 0, 0 ) 
    10201020            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10211021         END_2D 
    1022          DO_2D_00_00 
     1022         DO_2D( 0, 0, 0, 0 ) 
    10231023            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10241024         END_2D 
    … …  
    10311031      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21) 
    10321032         DO jl = 1, jpl 
    1033             DO_2D_10_10 
     1033            DO_2D( 1, 0, 1, 0 ) 
    10341034               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    10351035                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    … …  
    10391039      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23) 
    10401040         DO jl = 1, jpl 
    1041             DO_2D_10_10 
     1041            DO_2D( 1, 0, 1, 0 ) 
    10421042               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10431043               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    … …  
    10481048      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
    10491049         DO jl = 1, jpl 
    1050             DO_2D_10_10 
     1050            DO_2D( 1, 0, 1, 0 ) 
    10511051               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10521052               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10611061      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27) 
    10621062         DO jl = 1, jpl 
    1063             DO_2D_10_10 
     1063            DO_2D( 1, 0, 1, 0 ) 
    10641064               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10651065               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10741074      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29) 
    10751075         DO jl = 1, jpl 
    1076             DO_2D_10_10 
     1076            DO_2D( 1, 0, 1, 0 ) 
    10771077               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10781078               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10951095      IF( ll_neg ) THEN 
    10961096         DO jl = 1, jpl 
    1097             DO_2D_10_10 
     1097            DO_2D( 1, 0, 1, 0 ) 
    10981098               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    10991099                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    … …  
    11051105      !                                                     !-- High order flux in j-direction  --! 
    11061106      DO jl = 1, jpl 
    1107          DO_2D_10_10 
     1107         DO_2D( 1, 0, 1, 0 ) 
    11081108            pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 
    11091109         END_2D 
    … …  
    11411141      ! -------------------------------------------------- 
    11421142      DO jl = 1, jpl 
    1143          DO_2D_10_10 
     1143         DO_2D( 1, 0, 1, 0 ) 
    11441144            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
    11451145            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
    … …  
    11581158          
    11591159         DO jl = 1, jpl 
    1160             DO_2D_00_00 
     1160            DO_2D( 0, 0, 0, 0 ) 
    11611161               zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl) 
    11621162               ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl) 
    … …  
    11661166 
    11671167         DO jl = 1, jpl 
    1168             DO_2D_00_00 
     1168            DO_2D( 0, 0, 0, 0 ) 
    11691169               IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
    11701170                  & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 
    … …  
    11951195      DO jl = 1, jpl 
    11961196          
    1197          DO_2D_11_11 
     1197         DO_2D( 1, 1, 1, 1 ) 
    11981198            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
    11991199               zbup(ji,jj) = -zbig 
    … …  
    12111211         END_2D 
    12121212 
    1213          DO_2D_00_00 
     1213         DO_2D( 0, 0, 0, 0 ) 
    12141214            ! 
    12151215            zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood 
    … …  
    12481248      ! --------------------------------- 
    12491249      DO jl = 1, jpl 
    1250          DO_2D_10_10 
     1250         DO_2D( 1, 0, 1, 0 ) 
    12511251            zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
    12521252            zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 
    … …  
    12591259         END_2D 
    12601260 
    1261          DO_2D_10_10 
     1261         DO_2D( 1, 0, 1, 0 ) 
    12621262            zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
    12631263            zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
    … …  
    12931293      ! 
    12941294      DO jl = 1, jpl 
    1295          DO_2D_00_00 
     1295         DO_2D( 0, 0, 0, 0 ) 
    12961296            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
    12971297         END_2D 
    … …  
    13001300       
    13011301      DO jl = 1, jpl 
    1302          DO_2D_00_00 
     1302         DO_2D( 0, 0, 0, 0 ) 
    13031303            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    13041304             
    … …  
    13841384      ! 
    13851385      DO jl = 1, jpl 
    1386          DO_2D_00_00 
     1386         DO_2D( 0, 0, 0, 0 ) 
    13871387            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
    13881388         END_2D 
    … …  
    13911391 
    13921392      DO jl = 1, jpl 
    1393          DO_2D_00_00 
     1393         DO_2D( 0, 0, 0, 0 ) 
    13941394            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
    13951395 
    … …  
    14881488      ! 
    14891489      DO jl = 1, jpl 
    1490          DO_2D_11_11 
     1490         DO_2D( 1, 1, 1, 1 ) 
    14911491            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    14921492               ! 
    … …  
    15351535      !                                           ! -- check e_i/v_i -- ! 
    15361536      DO jl = 1, jpl 
    1537          DO_3D_11_11( 1, nlay_i ) 
     1537         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    15381538            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15391539               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15491549      !                                           ! -- check e_s/v_s -- ! 
    15501550      DO jl = 1, jpl 
    1551          DO_3D_11_11( 1, nlay_s ) 
     1551         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    15521552            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    15531553               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15921592      ! -- check snow load -- ! 
    15931593      DO jl = 1, jpl 
    1594          DO_2D_11_11 
     1594         DO_2D( 1, 1, 1, 1 ) 
    15951595            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15961596               ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90

    r13469 r13470  
    159159      npti = 0   ;   nptidx(:) = 0 
    160160      ipti = 0   ;   iptidx(:) = 0 
    161       DO_2D_11_11 
     161      DO_2D( 1, 1, 1, 1 ) 
    162162         IF ( at_i(ji,jj) > epsi10 ) THEN 
    163163            npti           = npti + 1 
    … …  
    775775      !                              !--------------------------------------------------! 
    776776      CASE( 1 )               !--- Spatial smoothing 
    777          DO_2D_00_00 
     777         DO_2D( 0, 0, 0, 0 ) 
    778778            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    779779               zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    … …  
    786786         END_2D 
    787787          
    788          DO_2D_00_00 
     788         DO_2D( 0, 0, 0, 0 ) 
    789789            strength(ji,jj) = zworka(ji,jj) 
    790790         END_2D 
    … …  
    797797         ENDIF 
    798798         ! 
    799          DO_2D_00_00 
     799         DO_2D( 0, 0, 0, 0 ) 
    800800            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    801801               itframe = 1 ! number of time steps for the running mean 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90

    r13469 r13470  
    182182      ! for diagnostics and convergence tests 
    183183      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    184       DO_2D_11_11 
     184      DO_2D( 1, 1, 1, 1 ) 
    185185         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    186186         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    … …  
    192192      !------------------------------------------------------------------------------! 
    193193      ! ocean/land mask 
    194       DO_2D_10_10 
     194      DO_2D( 1, 0, 1, 0 ) 
    195195         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    196196      END_2D 
    … …  
    198198 
    199199      ! Lateral boundary conditions on velocity (modify zfmask) 
    200       DO_2D_00_00 
     200      DO_2D( 0, 0, 0, 0 ) 
    201201         IF( zfmask(ji,jj) == 0._wp ) THEN 
    202202            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    … …  
    266266      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    267267 
    268       DO_2D_00_00 
     268      DO_2D( 0, 0, 0, 0 ) 
    269269 
    270270         ! ice fraction at U-V points 
    … …  
    317317      ! 
    318318      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016 
    319          DO_2D_00_00 
     319         DO_2D( 0, 0, 0, 0 ) 
    320320            ! ice thickness at U-V points 
    321321            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    … …  
    334334         ! 
    335335      ELSE                               !-- no landfast 
    336          DO_2D_00_00 
     336         DO_2D( 0, 0, 0, 0 ) 
    337337            ztaux_base(ji,jj) = 0._wp 
    338338            ztauy_base(ji,jj) = 0._wp 
    … …  
    351351         ! convergence test 
    352352         IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN 
    353             DO_2D_11_11 
     353            DO_2D( 1, 1, 1, 1 ) 
    354354               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
    355355               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
    … …  
    358358 
    359359         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    360          DO_2D_10_10 
     360         DO_2D( 1, 0, 1, 0 ) 
    361361 
    362362            ! shear at F points 
    … …  
    368368         CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 
    369369 
    370          DO_2D_01_01 
     370         DO_2D( 0, 1, 0, 1 ) 
    371371 
    372372            ! shear**2 at T points (doc eq. A16) 
    … …  
    417417         ! Save beta at T-points for further computations 
    418418         IF( ln_aEVP ) THEN 
    419             DO_2D_11_11 
     419            DO_2D( 1, 1, 1, 1 ) 
    420420               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
    421421            END_2D 
    422422         ENDIF 
    423423          
    424          DO_2D_10_10 
     424         DO_2D( 1, 0, 1, 0 ) 
    425425 
    426426            ! alpha for aEVP 
    … …  
    442442 
    443443         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    444          DO_2D_00_00 
     444         DO_2D( 0, 0, 0, 0 ) 
    445445            !                   !--- U points 
    446446            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    … …  
    470470         IF( MOD(jter,2) == 0 ) THEN ! even iterations 
    471471            ! 
    472             DO_2D_00_00 
     472            DO_2D( 0, 0, 0, 0 ) 
    473473               !                 !--- tau_io/(v_oce - v_ice) 
    474474               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    522522            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
    523523            ! 
    524             DO_2D_00_00 
     524            DO_2D( 0, 0, 0, 0 ) 
    525525               !                 !--- tau_io/(u_oce - u_ice) 
    526526               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    576576         ELSE ! odd iterations 
    577577            ! 
    578             DO_2D_00_00 
     578            DO_2D( 0, 0, 0, 0 ) 
    579579               !                 !--- tau_io/(u_oce - u_ice) 
    580580               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    628628            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
    629629            ! 
    630             DO_2D_00_00 
     630            DO_2D( 0, 0, 0, 0 ) 
    631631               !                 !--- tau_io/(v_oce - v_ice) 
    632632               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    693693      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
    694694      !------------------------------------------------------------------------------! 
    695       DO_2D_10_10 
     695      DO_2D( 1, 0, 1, 0 ) 
    696696 
    697697         ! shear at F points 
    … …  
    702702      END_2D 
    703703       
    704       DO_2D_00_00 
     704      DO_2D( 0, 0, 0, 0 ) 
    705705          
    706706         ! tension**2 at T points 
    … …  
    766766         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 
    767767         !          
    768          DO_2D_00_00 
     768         DO_2D( 0, 0, 0, 0 ) 
    769769            zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
    770770               &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
    … …  
    817817            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
    818818         ! 
    819          DO_2D_00_00 
     819         DO_2D( 0, 0, 0, 0 ) 
    820820            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    821821            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
    … …  
    917917         zresm = 0._wp 
    918918      ELSE 
    919          DO_2D_11_11 
     919         DO_2D( 1, 1, 1, 1 ) 
    920920            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    921921               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90

    r13469 r13470  
    287287         ! select ice covered grid points 
    288288         npti = 0 ; nptidx(:) = 0 
    289          DO_2D_11_11 
     289         DO_2D( 1, 1, 1, 1 ) 
    290290            IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    291291               npti         = npti  + 1 
    … …  
    342342         CALL ice_var_salprof ! for sz_i 
    343343         DO jl = 1, jpl 
    344             DO_2D_11_11 
     344            DO_2D( 1, 1, 1, 1 ) 
    345345               v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    346346               v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    … …  
    350350         ! 
    351351         DO jl = 1, jpl 
    352             DO_3D_11_11( 1, nlay_s ) 
     352            DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    353353               t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    354354               e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    … …  
    358358         ! 
    359359         DO jl = 1, jpl 
    360             DO_3D_11_11( 1, nlay_i ) 
     360            DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    361361               t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    362362               ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90

    r13469 r13470  
    9797      ! 
    9898      npti = 0   ;   nptidx(:) = 0 
    99       DO_2D_11_11 
     99      DO_2D( 1, 1, 1, 1 ) 
    100100         IF ( at_i(ji,jj) > epsi10 ) THEN 
    101101            npti = npti + 1 
    … …  
    604604         !                    !--------------------------------------- 
    605605         npti = 0   ;   nptidx(:) = 0 
    606          DO_2D_11_11 
     606         DO_2D( 1, 1, 1, 1 ) 
    607607            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
    608608               npti = npti + 1 
    … …  
    643643         !                    !----------------------------------------- 
    644644         npti = 0 ; nptidx(:) = 0 
    645          DO_2D_11_11 
     645         DO_2D( 1, 1, 1, 1 ) 
    646646            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
    647647               npti = npti + 1 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90

    r13469 r13470  
    7777      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    7878                                   CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    79          DO_2D_00_00 
     79         DO_2D( 0, 0, 0, 0 ) 
    8080            utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8181            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90

    r13469 r13470  
    120120         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    121121         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    122          DO_2D_00_00 
     122         DO_2D( 0, 0, 0, 0 ) 
    123123            zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
    124124               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    … …  
    126126         END_2D 
    127127      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    128          DO_2D_00_00 
     128         DO_2D( 0, 0, 0, 0 ) 
    129129            zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
    130130               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    … …  
    137137      ! Partial computation of forcing for the thermodynamic sea ice model 
    138138      !--------------------------------------------------------------------! 
    139       DO_2D_11_11 
     139      DO_2D( 1, 1, 1, 1 ) 
    140140         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    141141         ! 
    … …  
    209209         ! select ice covered grid points 
    210210         npti = 0 ; nptidx(:) = 0 
    211          DO_2D_11_11 
     211         DO_2D( 1, 1, 1, 1 ) 
    212212            IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    213213               npti         = npti  + 1 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90

    r13469 r13470  
    114114      ENDIF 
    115115       
    116       DO_2D_11_11 
     116      DO_2D( 1, 1, 1, 1 ) 
    117117 
    118118         ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    … …  
    333333      ! 
    334334      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    335          DO_2D_00_00 
     335         DO_2D( 0, 0, 0, 0 ) 
    336336            !                                               ! 2*(U_ice-U_oce) at T-point 
    337337            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)    
    … …  
    359359      ENDIF 
    360360      ! 
    361       DO_2D_00_00 
     361      DO_2D( 0, 0, 0, 0 ) 
    362362         ! ice area at u and v-points  
    363363         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  & 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90

    r13469 r13470  
    263263      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    264264      DO jl = 1, jpl 
    265          DO_3D_11_11( 1, nlay_i ) 
     265         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    266266            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
    267267               ! 
    … …  
    368368         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    369369         DO jl = 1, jpl 
    370             DO_2D_11_11 
     370            DO_2D( 1, 1, 1, 1 ) 
    371371               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    372372               !                             ! force a constant profile when SSS too low (Baltic Sea) 
    … …  
    377377         ! Computation of the profile 
    378378         DO jl = 1, jpl 
    379             DO_3D_11_11( 1, nlay_i ) 
     379            DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    380380               !                          ! linear profile with 0 surface value 
    381381               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    … …  
    507507         ! Zap ice energy and use ocean heat to melt ice 
    508508         !----------------------------------------------------------------- 
    509          DO_3D_11_11( 1, nlay_i ) 
     509         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    510510            ! update exchanges with ocean 
    511511            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    … …  
    514514         END_3D 
    515515         ! 
    516          DO_3D_11_11( 1, nlay_s ) 
     516         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    517517            ! update exchanges with ocean 
    518518            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    … …  
    524524         ! zap ice and snow volume, add water and salt to ocean 
    525525         !----------------------------------------------------------------- 
    526          DO_2D_11_11 
     526         DO_2D( 1, 1, 1, 1 ) 
    527527            ! update exchanges with ocean 
    528528            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice 
    … …  
    597597         ! zap ice energy and send it to the ocean 
    598598         !---------------------------------------- 
    599          DO_3D_11_11( 1, nlay_i ) 
     599         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    600600            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    601601               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
    … …  
    604604         END_3D 
    605605         ! 
    606          DO_3D_11_11( 1, nlay_s ) 
     606         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    607607            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    608608               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
    … …  
    614614         ! zap ice and snow volume, add water and salt to ocean 
    615615         !----------------------------------------------------- 
    616          DO_2D_11_11 
     616         DO_2D( 1, 1, 1, 1 ) 
    617617            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    618618               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90

    r13469 r13470  
    6969 
    7070      ! tresholds for outputs 
    71       DO_2D_11_11 
     71      DO_2D( 1, 1, 1, 1 ) 
    7272         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    7373         zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less 
    … …  
    7676      END_2D 
    7777      DO jl = 1, jpl 
    78          DO_2D_11_11 
     78         DO_2D( 1, 1, 1, 1 ) 
    7979            zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    8080            zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) 
    … …  
    130130      ! 
    131131      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity 
    132          DO_2D_00_00 
     132         DO_2D( 0, 0, 0, 0 ) 
    133133            z2da  = u_ice(ji,jj) + u_ice(ji-1,jj) 
    134134            z2db  = v_ice(ji,jj) + v_ice(ji,jj-1) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90

    r13469 r13470  
    140140                                       ! Read in masks to define closed seas and lakes  
    141141      ! 
    142       DO_2D_11_11 
     142      DO_2D( 1, 1, 1, 1 ) 
    143143         ik = mikt(ji,jj) 
    144144         risfdep(ji,jj) = gdepw_0(ji,jj,ik) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90

    r13469 r13470  
    253253         IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg 
    254254            CALL wad_spg( sshn, zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy 
    255             DO_2D_00_00 
     255            DO_2D( 0, 0, 0, 0 ) 
    256256               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   & 
    257257                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth 
    … …  
    260260            END_2D 
    261261         ELSE                                      ! now suface pressure gradient 
    262             DO_2D_00_00 
     262            DO_2D( 0, 0, 0, 0 ) 
    263263               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj) 
    264264               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)  
    … …  
    268268      ENDIF 
    269269      ! 
    270       DO_2D_00_00 
     270      DO_2D( 0, 0, 0, 0 ) 
    271271          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
    272272          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
    … …  
    281281      IF( ln_apr_dyn ) THEN 
    282282         IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2) 
    283             DO_2D_00_00 
     283            DO_2D( 0, 0, 0, 0 ) 
    284284               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
    285285               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
    … …  
    287287         ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW) 
    288288            zztmp = grav * r1_2 
    289             DO_2D_00_00 
     289            DO_2D( 0, 0, 0, 0 ) 
    290290               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  & 
    291291                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    … …  
    299299      !                                   !  ----------------------------------  ! 
    300300      IF( ln_bt_fw ) THEN                        ! Add wind forcing 
    301          DO_2D_00_00 
     301         DO_2D( 0, 0, 0, 0 ) 
    302302            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    303303            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
    … …  
    305305      ELSE 
    306306         zztmp = r1_rau0 * r1_2 
    307          DO_2D_00_00 
     307         DO_2D( 0, 0, 0, 0 ) 
    308308            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    309309            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
    … …  
    443443            ! 
    444444            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
    445             DO_2D_11_10 
     445            DO_2D( 1, 1, 1, 0 ) 
    446446               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    447447                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    448448                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    449449            END_2D 
    450             DO_2D_10_11 
     450            DO_2D( 1, 0, 1, 1 ) 
    451451               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    452452                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    … …  
    508508         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    509509         !-------------------------------------------------------------------------! 
    510          DO_2D_00_00 
     510         DO_2D( 0, 0, 0, 0 ) 
    511511            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    512512            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
    … …  
    533533         ! Sea Surface Height at u-,v-points (vvl case only) 
    534534         IF( .NOT.ln_linssh ) THEN                                 
    535             DO_2D_00_00 
     535            DO_2D( 0, 0, 0, 0 ) 
    536536               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    537537                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    … …  
    553553         !                             ! Surface pressure gradient 
    554554         zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor 
    555          DO_2D_00_00 
     555         DO_2D( 0, 0, 0, 0 ) 
    556556            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    557557            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    … …  
    571571         ! Add tidal astronomical forcing if defined 
    572572         IF ( ln_tide .AND. ln_tide_pot ) THEN 
    573             DO_2D_00_00 
     573            DO_2D( 0, 0, 0, 0 ) 
    574574               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    575575               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    … …  
    580580!jth do implicitly instead 
    581581         IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 
    582             DO_2D_00_00 
     582            DO_2D( 0, 0, 0, 0 ) 
    583583               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    584584               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
    … …  
    598598         !------------------------------------------------------------------------------------------------------------------------! 
    599599         IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form 
    600             DO_2D_00_00 
     600            DO_2D( 0, 0, 0, 0 ) 
    601601               ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
    602602                         &     + rdtbt * (                   zu_spg(ji,jj)   & 
    … …  
    613613            ! 
    614614         ELSE                           !* Flux form 
    615             DO_2D_00_00 
     615            DO_2D( 0, 0, 0, 0 ) 
    616616               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    617617               !                    ! backward interpolated depth used in spg terms at jn+1/2 
    … …  
    637637!jth implicit bottom friction: 
    638638         IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    639             DO_2D_00_00 
     639            DO_2D( 0, 0, 0, 0 ) 
    640640                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    641641                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
    … …  
    703703      IF (ln_bt_fw) THEN 
    704704         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 
    705             DO_2D_11_11 
     705            DO_2D( 1, 1, 1, 1 ) 
    706706               zun_save = un_adv(ji,jj) 
    707707               zvn_save = vn_adv(ji,jj) 
    … …  
    734734      ELSE 
    735735         ! At this stage, ssha has been corrected: compute new depths at velocity points 
    736          DO_2D_10_10 
     736         DO_2D( 1, 0, 1, 0 ) 
    737737            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    738738               &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      & 
    … …  
    969969      ! Max courant number for ext. grav. waves 
    970970      ! 
    971       DO_2D_11_11 
     971      DO_2D( 1, 1, 1, 1 ) 
    972972         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    973973         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
    … …  
    10931093         SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    10941094         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    1095             DO_2D_10_10 
     1095            DO_2D( 1, 0, 1, 0 ) 
    10961096               zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    10971097                    &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
    … …  
    10991099            END_2D 
    11001100         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    1101             DO_2D_10_10 
     1101            DO_2D( 1, 0, 1, 0 ) 
    11021102               zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      & 
    11031103                    &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   & 
    … …  
    11101110         ! 
    11111111         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1112          DO_2D_01_01 
     1112         DO_2D( 0, 1, 0, 1 ) 
    11131113            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    11141114            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
    … …  
    11191119      CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme) 
    11201120         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1121          DO_2D_01_01 
     1121         DO_2D( 0, 1, 0, 1 ) 
    11221122            z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    11231123            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
    … …  
    11521152            ! 
    11531153            !zhf(:,:) = hbatf(:,:) 
    1154             DO_2D_10_10 
     1154            DO_2D( 1, 0, 1, 0 ) 
    11551155               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
    11561156                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
    … …  
    11711171         CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 
    11721172         ! JC: TBC. hf should be greater than 0  
    1173          DO_2D_11_11 
     1173         DO_2D( 1, 1, 1, 1 ) 
    11741174            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
    11751175         END_2D 
    … …  
    11941194      SELECT CASE( nvor_scheme ) 
    11951195      CASE( np_ENT )                ! enstrophy conserving scheme (f-point) 
    1196          DO_2D_00_00 
     1196         DO_2D( 0, 0, 0, 0 ) 
    11971197            z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    11981198            z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    … …  
    12071207         !          
    12081208      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX 
    1209          DO_2D_00_00 
     1209         DO_2D( 0, 0, 0, 0 ) 
    12101210            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 
    12111211            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    … …  
    12181218         ! 
    12191219      CASE( np_ENS )                ! enstrophy conserving scheme (f-point) 
    1220          DO_2D_00_00 
     1220         DO_2D( 0, 0, 0, 0 ) 
    12211221            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) & 
    12221222              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    … …  
    12281228         ! 
    12291229      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)          
    1230          DO_2D_00_00 
     1230         DO_2D( 0, 0, 0, 0 ) 
    12311231            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) & 
    12321232             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) & 
    … …  
    12621262      ! 
    12631263      IF( ln_wd_dl_rmp ) THEN      
    1264          DO_2D_11_11 
     1264         DO_2D( 1, 1, 1, 1 ) 
    12651265            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN  
    12661266               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN  
    … …  
    12731273         END_2D 
    12741274      ELSE   
    1275          DO_2D_11_11 
     1275         DO_2D( 1, 1, 1, 1 ) 
    12761276            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp 
    12771277            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp 
    … …  
    13011301      !!---------------------------------------------------------------------- 
    13021302      ! 
    1303       DO_2D_11_10 
     1303      DO_2D( 1, 1, 1, 0 ) 
    13041304         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj)  
    13051305         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)   
    … …  
    13091309      END_2D 
    13101310      ! 
    1311       DO_2D_10_11 
     1311      DO_2D( 1, 0, 1, 1 ) 
    13121312         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  ) 
    13131313         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)   
    … …  
    13311331      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy 
    13321332      !!---------------------------------------------------------------------- 
    1333       DO_2D_00_00 
     1333      DO_2D( 0, 0, 0, 0 ) 
    13341334         ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                & 
    13351335              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    13971397      IF( ln_isfcav.OR.ln_drgice_imp ) THEN          ! top+bottom friction (ocean cavities) 
    13981398          
    1399          DO_2D_00_00 
     1399         DO_2D( 0, 0, 0, 0 ) 
    14001400            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 
    14011401            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 
    14021402         END_2D 
    14031403      ELSE                          ! bottom friction only 
    1404          DO_2D_00_00 
     1404         DO_2D( 0, 0, 0, 0 ) 
    14051405            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 
    14061406            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 
    … …  
    14121412      IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities 
    14131413          
    1414          DO_2D_00_00 
     1414         DO_2D( 0, 0, 0, 0 ) 
    14151415            ikbu = mbku(ji,jj)        
    14161416            ikbv = mbkv(ji,jj)     
    … …  
    14201420      ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities 
    14211421          
    1422          DO_2D_00_00 
     1422         DO_2D( 0, 0, 0, 0 ) 
    14231423            ikbu = mbku(ji,jj)        
    14241424            ikbv = mbkv(ji,jj)     
    … …  
    14301430      IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please ! 
    14311431         zztmp = -1._wp / rdtbt 
    1432          DO_2D_00_00 
     1432         DO_2D( 0, 0, 0, 0 ) 
    14331433            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 &  
    14341434                 &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  ) 
    … …  
    14381438      ELSE                    ! use "unclipped" drag (even if explicit friction is used in 3D calculation) 
    14391439          
    1440          DO_2D_00_00 
     1440         DO_2D( 0, 0, 0, 0 ) 
    14411441            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj) 
    14421442            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj) 
    … …  
    14501450         IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity 
    14511451             
    1452             DO_2D_00_00 
     1452            DO_2D( 0, 0, 0, 0 ) 
    14531453               iktu = miku(ji,jj) 
    14541454               iktv = mikv(ji,jj) 
    … …  
    14581458         ELSE                                ! CENTRED integration: use BEFORE top baroclinic velocity 
    14591459             
    1460             DO_2D_00_00 
     1460            DO_2D( 0, 0, 0, 0 ) 
    14611461               iktu = miku(ji,jj) 
    14621462               iktv = mikv(ji,jj) 
    … …  
    14681468         !                    ! use "unclipped" top drag (even if explicit friction is used in 3D calculation) 
    14691469          
    1470          DO_2D_00_00 
     1470         DO_2D( 0, 0, 0, 0 ) 
    14711471            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj) 
    14721472            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynzdf.F90

    r13469 r13470  
    131131            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
    132132         END DO 
    133          DO_2D_00_00 
     133         DO_2D( 0, 0, 0, 0 ) 
    134134            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    135135            ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    … …  
    140140         END_2D 
    141141         IF( ln_isfcav.OR.ln_drgice_imp ) THEN    ! Ocean cavities (ISF) 
    142             DO_2D_00_00 
     142            DO_2D( 0, 0, 0, 0 ) 
    143143               iku = miku(ji,jj)         ! top ocean level at u- and v-points  
    144144               ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    … …  
    158158         SELECT CASE( nldf_dyn ) 
    159159         CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu) 
    160             DO_3D_00_00( 1, jpkm1 ) 
     160            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    161161               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    162162               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   & 
    … …  
    171171            END_3D 
    172172         CASE DEFAULT               ! iso-level lateral mixing 
    173             DO_3D_00_00( 1, jpkm1 ) 
     173            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    174174               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    175175               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    … …  
    182182            END_3D 
    183183         END SELECT 
    184          DO_2D_00_00 
     184         DO_2D( 0, 0, 0, 0 ) 
    185185            zwi(ji,jj,1) = 0._wp 
    186186            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
    … …  
    193193         SELECT CASE( nldf_dyn ) 
    194194         CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu) 
    195             DO_3D_00_00( 1, jpkm1 ) 
     195            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    196196               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    197197               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   & 
    … …  
    204204            END_3D 
    205205         CASE DEFAULT               ! iso-level lateral mixing 
    206             DO_3D_00_00( 1, jpkm1 ) 
     206            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    207207               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    208208               zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    … …  
    213213            END_3D 
    214214         END SELECT 
    215          DO_2D_00_00 
     215         DO_2D( 0, 0, 0, 0 ) 
    216216            zwi(ji,jj,1) = 0._wp 
    217217            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    … …  
    227227      ! 
    228228      IF ( ln_drgimp ) THEN      ! implicit bottom friction 
    229          DO_2D_00_00 
     229         DO_2D( 0, 0, 0, 0 ) 
    230230            iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
    231231            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    … …  
    233233         END_2D 
    234234         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN   ! top friction (always implicit) 
    235             DO_2D_00_00 
     235            DO_2D( 0, 0, 0, 0 ) 
    236236               !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed 
    237237               iku = miku(ji,jj)       ! ocean top level at u- and v-points  
    … …  
    257257      !----------------------------------------------------------------------- 
    258258      ! 
    259       DO_3D_00_00( 2, jpkm1 ) 
     259      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    260260         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    261261      END_3D 
    262262      ! 
    263       DO_2D_00_00 
     263      DO_2D( 0, 0, 0, 0 ) 
    264264         ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)  
    265265         ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    266266            &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
    267267      END_2D 
    268       DO_3D_00_00( 2, jpkm1 ) 
     268      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    269269         ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
    270270      END_3D 
    271271      ! 
    272       DO_2D_00_00 
     272      DO_2D( 0, 0, 0, 0 ) 
    273273         ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    274274      END_2D 
    275       DO_3D_00_00( jpk-2, 1, -1 ) 
     275      DO_3D( 0, 0, 0, 0, jpk-2, 1, -1 ) 
    276276         ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    277277      END_3D 
    … …  
    284284         SELECT CASE( nldf_dyn ) 
    285285         CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzv) 
    286             DO_3D_00_00( 1, jpkm1 ) 
     286            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    287287               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    288288               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   & 
    … …  
    297297            END_3D 
    298298         CASE DEFAULT               ! iso-level lateral mixing 
    299             DO_3D_00_00( 1, jpkm1 ) 
     299            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    300300               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    301301               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    … …  
    308308            END_3D 
    309309         END SELECT 
    310          DO_2D_00_00 
     310         DO_2D( 0, 0, 0, 0 ) 
    311311            zwi(ji,jj,1) = 0._wp 
    312312            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
    … …  
    319319         SELECT CASE( nldf_dyn ) 
    320320         CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu) 
    321             DO_3D_00_00( 1, jpkm1 ) 
     321            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    322322               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    323323               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   & 
    … …  
    330330            END_3D 
    331331         CASE DEFAULT               ! iso-level lateral mixing 
    332             DO_3D_00_00( 1, jpkm1 ) 
     332            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    333333               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    334334               zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    … …  
    339339            END_3D 
    340340         END SELECT 
    341          DO_2D_00_00 
     341         DO_2D( 0, 0, 0, 0 ) 
    342342            zwi(ji,jj,1) = 0._wp 
    343343            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    … …  
    352352      ! 
    353353      IF( ln_drgimp ) THEN 
    354          DO_2D_00_00 
     354         DO_2D( 0, 0, 0, 0 ) 
    355355            ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    356356            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    … …  
    358358         END_2D 
    359359         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN 
    360             DO_2D_00_00 
     360            DO_2D( 0, 0, 0, 0 ) 
    361361               ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    362362               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    … …  
    381381      !----------------------------------------------------------------------- 
    382382      ! 
    383       DO_3D_00_00( 2, jpkm1 ) 
     383      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    384384         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    385385      END_3D 
    386386      ! 
    387       DO_2D_00_00 
     387      DO_2D( 0, 0, 0, 0 ) 
    388388         ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)  
    389389         va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    390390            &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1)  
    391391      END_2D 
    392       DO_3D_00_00( 2, jpkm1 ) 
     392      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    393393         va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
    394394      END_3D 
    395395      ! 
    396       DO_2D_00_00 
     396      DO_2D( 0, 0, 0, 0 ) 
    397397         va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    398398      END_2D 
    399       DO_3D_00_00( jpk-2, 1, -1 ) 
     399      DO_3D( 0, 0, 0, 0, jpk-2, 1, -1 ) 
    400400         va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    401401      END_3D 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_oce.F90

    r13469 r13470  
    209209      !!--------------------------------------------------------------------- 
    210210      zcoef = 0.5 / ( zrhoa * zcdrag )  
    211       DO_2D_00_00 
     211      DO_2D( 0, 0, 0, 0 ) 
    212212         ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    213213         zty = vtau(ji  ,jj-1) + vtau(ji,jj)  

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk.F90

    r13469 r13470  
    408408#if defined key_cyclone 
    409409      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    410       DO_2D_00_00 
     410      DO_2D( 0, 0, 0, 0 ) 
    411411         sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj) 
    412412         sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj) 
    413413      END_2D 
    414414#endif 
    415       DO_2D_00_00 
     415      DO_2D( 0, 0, 0, 0 ) 
    416416         zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    417417         zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    … …  
    470470!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef. 
    471471 
    472       DO_2D_11_11 
     472      DO_2D( 1, 1, 1, 1 ) 
    473473         zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed 
    474474         taum  (ji,jj) = zztmp * wndm  (ji,jj) 
    … …  
    485485      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    486486      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    487       DO_2D_10_10 
     487      DO_2D( 1, 0, 1, 0 ) 
    488488         utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    489489            &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    … …  
    625625      !!---------------------------------------------------------------------------------- 
    626626      ! 
    627       DO_2D_11_11 
     627      DO_2D( 1, 1, 1, 1 ) 
    628628         ! 
    629629         ztmp = rt0 / ptak(ji,jj) 
    … …  
    659659      !!---------------------------------------------------------------------------------- 
    660660      ! 
    661       DO_2D_11_11 
     661      DO_2D( 1, 1, 1, 1 ) 
    662662         zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 
    663663         ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT 
    … …  
    723723      ! ------------------------------------------------------------ ! 
    724724      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    725       DO_2D_00_00 
     725      DO_2D( 0, 0, 0, 0 ) 
    726726         zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    727727         zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
    … …  
    749749      ! ------------------------------------------------------------ ! 
    750750      zztmp1 = rn_vfac * 0.5_wp 
    751       DO_2D_01_01 
     751      DO_2D( 0, 1, 0, 1 ) 
    752752         zztmp2 = zrhoa(ji,jj) * Cd_atm(ji,jj) * wndm_ice(ji,jj) 
    753753         utau_ice(ji,jj) = zztmp2 * ( sf(jp_wndi)%fnow(ji,jj,1) - zztmp1 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) ) ) 
    … …  
    755755      END_2D 
    756756      ! 
    757       DO_2D_00_00 
     757      DO_2D( 0, 0, 0, 0 ) 
    758758         ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
    759759         zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    … …  
    10071007         !    
    10081008         DO jl = 1, jpl                 
    1009             DO_2D_11_11 
     1009            DO_2D( 1, 1, 1, 1 ) 
    10101010               zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness 
    10111011               IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 
    … …  
    10221022      ! 
    10231023      DO jl = 1, jpl 
    1024          DO_2D_11_11 
     1024         DO_2D( 1, 1, 1, 1 ) 
    10251025            !                     
    10261026            zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
    … …  
    11731173      zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
    11741174      ! 
    1175       DO_2D_00_00 
     1175      DO_2D( 0, 0, 0, 0 ) 
    11761176         ! Virtual potential temperature [K] 
    11771177         zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90

    r13469 r13470  
    214214      !!---------------------------------------------------------------------------------- 
    215215      ! 
    216       DO_2D_11_11 
     216      DO_2D( 1, 1, 1, 1 ) 
    217217         ! 
    218218         zw  = pw10(ji,jj) 
    … …  
    279279      REAL(wp) :: zzeta, zx2, zx, zpsi_unst, zpsi_stab,  zstab   ! local scalars 
    280280      !!---------------------------------------------------------------------------------- 
    281       DO_2D_11_11 
     281      DO_2D( 1, 1, 1, 1 ) 
    282282 
    283283         zzeta = pzeta(ji,jj) 
    … …  
    318318      !!---------------------------------------------------------------------------------- 
    319319      ! 
    320       DO_2D_11_11 
     320      DO_2D( 1, 1, 1, 1 ) 
    321321         ! 
    322322         zzeta = pzeta(ji,jj) 
    … …  
    376376      !!------------------------------------------------------------------- 
    377377      ! 
    378       DO_2D_11_11 
     378      DO_2D( 1, 1, 1, 1 ) 
    379379         ! 
    380380         zqa = (1._wp + rctv0*pqa(ji,jj)) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90

    r13469 r13470  
    11931193            !                               
    11941194            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 
    1195                DO_2D_00_00 
     1195               DO_2D( 0, 0, 0, 0 ) 
    11961196                  frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 
    11971197                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    … …  
    12171217         ! => need to be done only when otx1 was changed 
    12181218         IF( llnewtx ) THEN 
    1219             DO_2D_00_00 
     1219            DO_2D( 0, 0, 0, 0 ) 
    12201220               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 
    12211221               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 
    … …  
    12421242         IF( llnewtau ) THEN  
    12431243            zcoef = 1. / ( zrhoa * zcdrag )  
    1244             DO_2D_11_11 
     1244            DO_2D( 1, 1, 1, 1 ) 
    12451245               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    12461246            END_2D 
    … …  
    15801580            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    15811581         CASE( 'T' ) 
    1582             DO_2D_00_00 
     1582            DO_2D( 0, 0, 0, 0 ) 
    15831583               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
    15841584               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    … …  
    24632463            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    24642464            CASE( 'oce only'             )      ! C-grid ==> T 
    2465                DO_2D_00_00 
     2465               DO_2D( 0, 0, 0, 0 ) 
    24662466                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) ) 
    24672467                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji  ,jj-1,1,Nii) )  
    24682468               END_2D 
    24692469            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
    2470                DO_2D_00_00 
     2470               DO_2D( 0, 0, 0, 0 ) 
    24712471                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   
    24722472                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj) 
    … …  
    24762476               CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 
    24772477            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    2478                DO_2D_00_00 
     2478               DO_2D( 0, 0, 0, 0 ) 
    24792479                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   & 
    24802480                     &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    … …  
    25402540          SELECT CASE( TRIM( sn_snd_crtw%cldes ) )  
    25412541          CASE( 'oce only'             )      ! C-grid ==> T  
    2542              DO_2D_00_00 
     2542             DO_2D( 0, 0, 0, 0 ) 
    25432543                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) )  
    25442544                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji , jj-1,1,Nii) )   
    25452545             END_2D 
    25462546          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T    
    2547              DO_2D_00_00 
     2547             DO_2D( 0, 0, 0, 0 ) 
    25482548                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)    
    25492549                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj)  
    … …  
    25532553             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. )  
    25542554          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T   
    2555              DO_2D_00_00 
     2555             DO_2D( 0, 0, 0, 0 ) 
    25562556                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   &  
    25572557                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90

    r13469 r13470  
    115115      ! 
    116116      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    117          DO_2D_00_00 
     117         DO_2D( 0, 0, 0, 0 ) 
    118118            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    119119            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point 
    … …  
    127127         END_2D 
    128128      ELSE                                            !==  standard Cd  ==! 
    129          DO_2D_00_00 
     129         DO_2D( 0, 0, 0, 0 ) 
    130130            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    131131            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point 
    … …  
    173173      ENDIF 
    174174 
    175       DO_2D_00_00 
     175      DO_2D( 0, 0, 0, 0 ) 
    176176         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
    177177         ikbv = mbkv(ji,jj) 
    … …  
    186186      ! 
    187187      IF( ln_isfcav ) THEN        ! ocean cavities 
    188          DO_2D_00_00 
     188         DO_2D( 0, 0, 0, 0 ) 
    189189            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
    190190            ikbv = mikv(ji,jj) 
    … …  
    434434            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    435435            ! 
    436             DO_2D_11_11 
     436            DO_2D( 1, 1, 1, 1 ) 
    437437               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
    438438               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfgls.F90

    r13469 r13470  
    177177       
    178178      ! Compute surface, top and bottom friction at T-points 
    179       DO_2D_00_00 
     179      DO_2D( 0, 0, 0, 0 ) 
    180180         ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
    181181      END_2D 
    … …  
    184184      !     
    185185      IF( .NOT.ln_drg_OFF ) THEN    !== top/bottom friction   (explicit before friction) 
    186          DO_2D_00_00 
     186         DO_2D( 0, 0, 0, 0 ) 
    187187            zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    188188            zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
    … …  
    191191         END_2D 
    192192         IF( ln_isfcav ) THEN       !top friction 
    193             DO_2D_00_00 
     193            DO_2D( 0, 0, 0, 0 ) 
    194194               zmsku = ( 2._wp - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    195195               zmskv = ( 2._wp - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
    … …  
    218218      zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro 
    219219      ! 
    220       DO_3D_10_10( 2, jpkm1 ) 
     220      DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
    221221         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
    222222      END_3D 
    … …  
    227227 
    228228      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada 
    229          DO_3D_00_00( 2, jpkm1 ) 
     229         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    230230            zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1) 
    231231            zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ) 
    … …  
    248248      ! Warning : after this step, en : right hand side of the matrix 
    249249 
    250       DO_3D_00_00( 2, jpkm1 ) 
     250      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    251251         ! 
    252252         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction 
    … …  
    342342         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    343343         !                      ! Balance between the production and the dissipation terms 
    344          DO_2D_00_00 
     344         DO_2D( 0, 0, 0, 0 ) 
    345345!!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ???? 
    346346!!   With thick deep ocean level thickness, this may be quite large, no ??? 
    … …  
    360360         ! 
    361361         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    362             DO_2D_00_00 
     362            DO_2D( 0, 0, 0, 0 ) 
    363363               itop   = mikt(ji,jj)       ! k   top w-point 
    364364               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    … …  
    378378      CASE ( 1 )             ! Neumman boundary condition 
    379379         !                       
    380          DO_2D_00_00 
     380         DO_2D( 0, 0, 0, 0 ) 
    381381            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    382382            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    392392         END_2D 
    393393         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    394             DO_2D_00_00 
     394            DO_2D( 0, 0, 0, 0 ) 
    395395               itop   = mikt(ji,jj)       ! k   top w-point 
    396396               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    … …  
    412412      ! ---------------------------------------------------------- 
    413413      ! 
    414       DO_3D_00_00( 2, jpkm1 ) 
     414      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    415415         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    416416      END_3D 
    417       DO_3D_00_00( 2, jpk ) 
     417      DO_3D( 0, 0, 0, 0, 2, jpk ) 
    418418         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) 
    419419      END_3D 
    420       DO_3D_00_00( jpk-1, 2, -1 ) 
     420      DO_3D( 0, 0, 0, 0, jpk-1, 2, -1 ) 
    421421         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    422422      END_3D 
    … …  
    433433      ! 
    434434      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    435          DO_3D_00_00( 2, jpkm1 ) 
     435         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    436436            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
    437437         END_3D 
    438438         ! 
    439439      CASE( 1 )               ! k-eps 
    440          DO_3D_00_00( 2, jpkm1 ) 
     440         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    441441            psi(ji,jj,jk)  = eps(ji,jj,jk) 
    442442         END_3D 
    443443         ! 
    444444      CASE( 2 )               ! k-w 
    445          DO_3D_00_00( 2, jpkm1 ) 
     445         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    446446            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
    447447         END_3D 
    448448         ! 
    449449      CASE( 3 )               ! generic 
    450          DO_3D_00_00( 2, jpkm1 ) 
     450         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    451451            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn  
    452452         END_3D 
    … …  
    461461      ! Warning : after this step, en : right hand side of the matrix 
    462462 
    463       DO_3D_00_00( 2, jpkm1 ) 
     463      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    464464         ! 
    465465         ! psi / k 
    … …  
    557557         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    558558         !                      ! Balance between the production and the dissipation terms 
    559          DO_2D_00_00 
     559         DO_2D( 0, 0, 0, 0 ) 
    560560            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    561561            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    576576      CASE ( 1 )             ! Neumman boundary condition 
    577577         !                       
    578          DO_2D_00_00 
     578         DO_2D( 0, 0, 0, 0 ) 
    579579            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    580580            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    604604      ! ---------------- 
    605605      ! 
    606       DO_3D_00_00( 2, jpkm1 ) 
     606      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    607607         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    608608      END_3D 
    609       DO_3D_00_00( 2, jpk ) 
     609      DO_3D( 0, 0, 0, 0, 2, jpk ) 
    610610         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    611611      END_3D 
    612       DO_3D_00_00( jpk-1, 2, -1 ) 
     612      DO_3D( 0, 0, 0, 0, jpk-1, 2, -1 ) 
    613613         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    614614      END_3D 
    … …  
    620620      ! 
    621621      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    622          DO_3D_00_00( 1, jpkm1 ) 
     622         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    623623            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 
    624624         END_3D 
    625625         ! 
    626626      CASE( 1 )               ! k-eps 
    627          DO_3D_00_00( 1, jpkm1 ) 
     627         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    628628            eps(ji,jj,jk) = psi(ji,jj,jk) 
    629629         END_3D 
    630630         ! 
    631631      CASE( 2 )               ! k-w 
    632          DO_3D_00_00( 1, jpkm1 ) 
     632         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    633633            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)  
    634634         END_3D 
    … …  
    638638         zex1  =      ( 1.5_wp + rmm/rnn ) 
    639639         zex2  = -1._wp / rnn 
    640          DO_3D_00_00( 1, jpkm1 ) 
     640         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    641641            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
    642642         END_3D 
    … …  
    646646      ! Limit dissipation rate under stable stratification 
    647647      ! -------------------------------------------------- 
    648       DO_3D_00_00( 1, jpkm1 ) 
     648      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    649649         ! limitation 
    650650         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
    … …  
    662662      ! 
    663663      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions 
    664          DO_3D_00_00( 2, jpkm1 ) 
     664         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    665665            ! zcof =  l²/q² 
    666666            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 
    … …  
    679679         ! 
    680680      CASE ( 2, 3 )               ! Canuto stability functions 
    681          DO_3D_00_00( 2, jpkm1 ) 
     681         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    682682            ! zcof =  l²/q² 
    683683            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 
    … …  
    711711      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    712712      zstm(:,:,jpk) = 0.   
    713       DO_2D_00_00 
     713      DO_2D( 0, 0, 0, 0 ) 
    714714         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    715715      END_2D 
    … …  
    726726      !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 
    727727      !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 
    728       DO_3D_00_00( 1, jpk ) 
     728      DO_3D( 0, 0, 0, 0, 1, jpk ) 
    729729         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 
    730730         zavt  = zsqen * zstt(ji,jj,jk) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdftke.F90

    r13469 r13470  
    231231      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    232232      ! 
    233       DO_2D_00_00 
     233      DO_2D( 0, 0, 0, 0 ) 
    234234!! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 
    235235!!       one way around would be to increase zbbirau  
    … …  
    249249      IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE 
    250250         ! 
    251          DO_2D_00_00 
     251         DO_2D( 0, 0, 0, 0 ) 
    252252            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    253253            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
    … …  
    258258         END_2D 
    259259         IF( ln_isfcav ) THEN       ! top friction 
    260             DO_2D_00_00 
     260            DO_2D( 0, 0, 0, 0 ) 
    261261               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    262262               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
    … …  
    283283         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
    284284         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    285          DO_3D_11_11( jpkm1, 2, -1 ) 
     285         DO_3D( 1, 1, 1, 1, jpkm1, 2, -1 ) 
    286286            zus  = zcof * taum(ji,jj) 
    287287            IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
    288288         END_3D 
    289289         !                               ! finite LC depth 
    290          DO_2D_11_11 
     290         DO_2D( 1, 1, 1, 1 ) 
    291291            zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj)) 
    292292         END_2D 
    293293         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    294          DO_2D_00_00 
     294         DO_2D( 0, 0, 0, 0 ) 
    295295            zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    296296            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    297297         END_2D 
    298          DO_3D_00_00( 2, jpkm1 ) 
     298         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    299299            IF ( zus3(ji,jj) /= 0._wp ) THEN                
    300300               ! vertical velocity due to LC    
    … …  
    318318      ! 
    319319      IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri ) 
    320          DO_3D_00_00( 2, jpkm1 ) 
     320         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    321321            !                             ! local Richardson number 
    322322            zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear ) 
    … …  
    326326      ENDIF 
    327327      !          
    328       DO_3D_00_00( 2, jpkm1 ) 
     328      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    329329         zcof   = zfact1 * tmask(ji,jj,jk) 
    330330         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
    … …  
    346346      END_3D 
    347347      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    348       DO_3D_00_00( 3, jpkm1 ) 
     348      DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
    349349         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    350350      END_3D 
    351       DO_2D_00_00 
     351      DO_2D( 0, 0, 0, 0 ) 
    352352         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    353353      END_2D 
    354       DO_3D_00_00( 3, jpkm1 ) 
     354      DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
    355355         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) 
    356356      END_3D 
    357       DO_2D_00_00 
     357      DO_2D( 0, 0, 0, 0 ) 
    358358         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    359359      END_2D 
    360       DO_3D_00_00( jpk-2, 2, -1 ) 
     360      DO_3D( 0, 0, 0, 0, jpk-2, 2, -1 ) 
    361361         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    362362      END_3D 
    363       DO_3D_00_00( 2, jpkm1 ) 
     363      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    364364         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    365365      END_3D 
    … …  
    373373       
    374374      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    375          DO_3D_00_00( 2, jpkm1 ) 
     375         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    376376            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    377377               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    378378         END_3D 
    379379      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    380          DO_2D_00_00 
     380         DO_2D( 0, 0, 0, 0 ) 
    381381            jk = nmln(ji,jj) 
    382382            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    … …  
    384384         END_2D 
    385385      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    386          DO_3D_00_00( 2, jpkm1 ) 
     386         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    387387            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    388388            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    … …  
    459459         zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 
    460460#if ! defined key_si3 && ! defined key_cice 
    461          DO_2D_00_00 
     461         DO_2D( 0, 0, 0, 0 ) 
    462462            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    463463         END_2D 
    … …  
    467467         ! 
    468468         CASE( 0 )                      ! No scaling under sea-ice 
    469             DO_2D_00_00 
     469            DO_2D( 0, 0, 0, 0 ) 
    470470               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
    471471            END_2D 
    472472            ! 
    473473         CASE( 1 )                      ! scaling with constant sea-ice thickness 
    474             DO_2D_00_00 
     474            DO_2D( 0, 0, 0, 0 ) 
    475475               zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    476476                  &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
    … …  
    478478            ! 
    479479         CASE( 2 )                      ! scaling with mean sea-ice thickness 
    480             DO_2D_00_00 
     480            DO_2D( 0, 0, 0, 0 ) 
    481481#if defined key_si3 
    482482               zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    … …  
    490490            ! 
    491491         CASE( 3 )                      ! scaling with max sea-ice thickness 
    492             DO_2D_00_00 
     492            DO_2D( 0, 0, 0, 0 ) 
    493493               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    494494               zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    … …  
    499499#endif 
    500500         ! 
    501          DO_2D_00_00 
     501         DO_2D( 0, 0, 0, 0 ) 
    502502            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    503503         END_2D 
    … …  
    507507      ENDIF 
    508508      ! 
    509       DO_3D_00_00( 2, jpkm1 ) 
     509      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    510510         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    511511         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
    … …  
    522522      ! where wmask = 0 set zmxlm == p_e3w 
    523523      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    524          DO_3D_00_00( 2, jpkm1 ) 
     524         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    525525            zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   & 
    526526            &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) ) 
    … …  
    531531         ! 
    532532      CASE ( 1 )           ! bounded by the vertical scale factor 
    533          DO_3D_00_00( 2, jpkm1 ) 
     533         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    534534            zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) ) 
    535535            zmxlm(ji,jj,jk) = zemxl 
    … …  
    538538         ! 
    539539      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    540          DO_3D_00_00( 2, jpkm1 ) 
     540         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    541541            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    542542         END_3D 
    543          DO_3D_00_00( jpkm1, 2, -1 ) 
     543         DO_3D( 0, 0, 0, 0, jpkm1, 2, -1 ) 
    544544            zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    545545            zmxlm(ji,jj,jk) = zemxl 
    … …  
    548548         ! 
    549549      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    550          DO_3D_00_00( 2, jpkm1 ) 
     550         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    551551            zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    552552         END_3D 
    553          DO_3D_00_00( jpkm1, 2, -1 ) 
     553         DO_3D( 0, 0, 0, 0, jpkm1, 2, -1 ) 
    554554            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    555555         END_3D 
    556          DO_3D_00_00( 2, jpkm1 ) 
     556         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    557557            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    558558            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
    … …  
    566566      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    567567      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    568       DO_3D_00_00( 1, jpkm1 ) 
     568      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    569569         zsqen = SQRT( en(ji,jj,jk) ) 
    570570         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
    … …  
    576576      ! 
    577577      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
    578          DO_3D_00_00( 2, jpkm1 ) 
     578         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    579579            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) 
    580580         END_3D 

  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13469 r13470  
    8989      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9090      ! ------------------------------------------------------------ 
    91       DO_3D_11_11( 1, jpkm1 ) 
     91      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    9292         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    9393         zkeq            = fekeq(ji,jj,jk) 
    … …  
    104104 
    105105      zdust = 0.         ! if no dust available 
    106       DO_3D_11_11( 1, jpkm1 ) 
     106      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    107107         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    108108         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    … …  
    170170      IF( ln_ligand ) THEN 
    171171         ! 
    172          DO_3D_11_11( 1, jpkm1 ) 
     172         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    173173            zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    174174                &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 

  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90

    r13469 r13470  
    126126            CALL fld_read( kt, 1, sf_river ) 
    127127            IF( ln_p4z ) THEN 
    128                DO_2D_11_11 
     128               DO_2D( 1, 1, 1, 1 ) 
    129129                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    130130                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & 
    … …  
    142142               END_2D 
    143143            ELSE    !  ln_p5z 
    144                DO_2D_11_11 
     144               DO_2D( 1, 1, 1, 1 ) 
    145145                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    146146                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
    … …  
    407407         IF(lwp) WRITE(numout,*) 
    408408         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    409          DO_3D_00_00( 1, ik50 ) 
     409         DO_3D( 0, 0, 0, 0, 1, ik50 ) 
    410410            ze3t   = e3t_0(ji,jj,jk) 
    411411            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
    … …  
    423423         CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    424424         ! 
    425          DO_3D_11_11( 1, jpk ) 
     425         DO_3D( 1, 1, 1, 1, 1, jpk ) 
    426426            zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
    427427            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 

  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsms.F90

    r13469 r13470  
    127127         xnegtr(:,:,:) = 1.e0 
    128128         DO jn = jp_pcs0, jp_pcs1 
    129             DO_3D_11_11( 1, jpk ) 
     129            DO_3D( 1, 1, 1, 1, 1, jpk ) 
    130130               IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    131131                  ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/diawri.F90

    r13469 r13470  
    150150      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    151151      IF ( iom_use("sbt") ) THEN 
    152          DO_2D_11_11 
     152         DO_2D( 1, 1, 1, 1 ) 
    153153            ikbot = mbkt(ji,jj) 
    154154            z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 
    … …  
    160160      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    161161      IF ( iom_use("sbs") ) THEN 
    162          DO_2D_11_11 
     162         DO_2D( 1, 1, 1, 1 ) 
    163163            ikbot = mbkt(ji,jj) 
    164164            z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 
    … …  
    170170         zztmp = rau0 * 0.25 
    171171         z2d(:,:) = 0._wp 
    172          DO_2D_00_00 
     172         DO_2D( 0, 0, 0, 0 ) 
    173173            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Nii)  )**2   & 
    174174               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Nii)  )**2   & 
    … …  
    185185      CALL iom_put(  "ssu", uu(:,:,1,Nii) )            ! surface i-current 
    186186      IF ( iom_use("sbu") ) THEN 
    187          DO_2D_11_11 
     187         DO_2D( 1, 1, 1, 1 ) 
    188188            ikbot = mbku(ji,jj) 
    189189            z2d(ji,jj) = uu(ji,jj,ikbot,Nii) 
    … …  
    195195      CALL iom_put(  "ssv", vv(:,:,1,Nii) )            ! surface j-current 
    196196      IF ( iom_use("sbv") ) THEN 
    197          DO_2D_11_11 
     197         DO_2D( 1, 1, 1, 1 ) 
    198198            ikbot = mbkv(ji,jj) 
    199199            z2d(ji,jj) = vv(ji,jj,ikbot,Nii) 
    … …  
    222222      IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 
    223223         z3d(:,:,jpk) = 0. 
    224          DO_3D_00_00( 1, jpkm1 ) 
     224         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    225225            zztmp  = tsn(ji,jj,jk,jp_sal) 
    226226            zztmpx = ( tsn(ji+1,jj,jk,jp_sal) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,jk,jp_sal) ) * r1_e1u(ji-1,jj) 
    … …  
    236236          
    237237      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    238          DO_2D_00_00 
     238         DO_2D( 0, 0, 0, 0 ) 
    239239            zztmp  = tsn(ji,jj,1,jp_tem) 
    240240            zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj) 
    … …  
    252252      IF( iom_use("heatc") ) THEN 
    253253         z2d(:,:)  = 0._wp  
    254          DO_3D_11_11( 1, jpkm1 ) 
     254         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    255255            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    256256         END_3D 
    … …  
    260260      IF( iom_use("saltc") ) THEN 
    261261         z2d(:,:)  = 0._wp  
    262          DO_3D_11_11( 1, jpkm1 ) 
     262         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    263263            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    264264         END_3D 
    … …  
    268268      IF( iom_use("salt2c") ) THEN 
    269269         z2d(:,:)  = 0._wp  
    270          DO_3D_11_11( 1, jpkm1 ) 
     270         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    271271            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    272272         END_3D 
    … …  
    276276      IF ( iom_use("eken") .OR. iom_use("eken_int") ) THEN 
    277277         z3d(:,:,jpk) = 0._wp  
    278          DO_3D_00_00( 1, jpkm1 ) 
     278         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    279279            zztmpx = 0.5 * ( uu(ji-1,jj  ,jk,Nii) + uu(ji,jj,jk,Nii) ) 
    280280            zztmpy = 0.5 * ( vv(ji  ,jj-1,jk,Nii) + vv(ji,jj,jk,Nii) ) 
    … …  
    285285 
    286286         z2d(:,:)  = 0._wp  
    287          DO_3D_11_11( 1, jpkm1 ) 
     287         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    288288            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 
    289289         END_3D 
    … …  
    296296          
    297297         z3d(:,:,jpk) = 0._wp  
    298          DO_3D_10_10( 1, jpkm1 ) 
     298         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    299299            z3d(ji,jj,jk) = (  e2v(ji+1,jj  ) * vv(ji+1,jj  ,jk,Nii) - e2v(ji,jj) * vv(ji,jj,jk,Nii)    & 
    300300               &             - e1u(ji  ,jj+1) * uu(ji  ,jj+1,jk,Nii) + e1u(ji,jj) * uu(ji,jj,jk,Nii)  ) * r1_e1e2f(ji,jj) 
    … …  
    303303         CALL iom_put( "relvor", z3d )                  ! relative vorticity 
    304304 
    305          DO_3D_11_11( 1, jpkm1 ) 
     305         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    306306            z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk)  
    307307         END_3D 
    308308         CALL iom_put( "absvor", z3d )                  ! absolute vorticity 
    309309 
    310          DO_3D_10_10( 1, jpkm1 ) 
     310         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    311311            ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    312312               &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  ) 
    … …  
    335335      IF( iom_use("u_heattr") ) THEN 
    336336         z2d(:,:) = 0._wp  
    337          DO_3D_00_00( 1, jpkm1 ) 
     337         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    338338            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    339339         END_3D 
    … …  
    344344      IF( iom_use("u_salttr") ) THEN 
    345345         z2d(:,:) = 0.e0  
    346          DO_3D_00_00( 1, jpkm1 ) 
     346         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    347347            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    348348         END_3D 
    … …  
    362362      IF( iom_use("v_heattr") ) THEN 
    363363         z2d(:,:) = 0.e0  
    364          DO_3D_00_00( 1, jpkm1 ) 
     364         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    365365            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    366366         END_3D 
    … …  
    371371      IF( iom_use("v_salttr") ) THEN 
    372372         z2d(:,:) = 0._wp  
    373          DO_3D_00_00( 1, jpkm1 ) 
     373         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    374374            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
    375375         END_3D 
    … …  
    380380      IF( iom_use("tosmint") ) THEN 
    381381         z2d(:,:) = 0._wp 
    382          DO_3D_00_00( 1, jpkm1 ) 
     382         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    383383            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
    384384         END_3D 
    … …  
    388388      IF( iom_use("somint") ) THEN 
    389389         z2d(:,:)=0._wp 
    390          DO_3D_00_00( 1, jpkm1 ) 
     390         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    391391            z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
    392392         END_3D 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

    r13469 r13470  
    201201      CASE(4)    ! geostrophic zonal pulse 
    202202    
    203          DO_2D_11_11 
     203         DO_2D( 1, 1, 1, 1 ) 
    204204            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
    205205               zdu = rn_uzonal 
    … …  
    236236         zP0 = rau0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
    237237         ! 
    238          DO_2D_11_11 
     238         DO_2D( 1, 1, 1, 1 ) 
    239239            zx = glamt(ji,jj) * 1.e3 
    240240            zy = gphit(ji,jj) * 1.e3 
    … …  
    267267         ! velocities: 
    268268         za = 2._wp * zP0 / zlambda**2 
    269          DO_2D_00_00 
     269         DO_2D( 0, 0, 0, 0 ) 
    270270            zx = glamu(ji,jj) * 1.e3 
    271271            zy = gphiu(ji,jj) * 1.e3 
    … …  
    282282         END_2D 
    283283         ! 
    284          DO_2D_00_00 
     284         DO_2D( 0, 0, 0, 0 ) 
    285285            zx = glamv(ji,jj) * 1.e3 
    286286            zy = gphiv(ji,jj) * 1.e3 
Note: See TracChangeset for help on using the changeset viewer.