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 13469 for NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90 – NEMO

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

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

File:
1 edited

Legend:

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

    r13466 r13469  
    115115      ! 
    116116      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    117          DO jj = 2, jpjm1 
    118             DO ji = 2, jpim1 
    119                imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    120                zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point 
    121                zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 
    122                zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary 
    123                ! 
     117         DO_2D_00_00 
     118            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
     119            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point 
     120            zvt = vv(ji,jj,imk,Nii) + vv(ji,jj-1,imk,Nii) 
     121            zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary 
     122            ! 
    124123!!JC: possible WAD implementation should modify line below if layers vanish 
    125                zcd = (  vkarmn / LOG( zzz / pz0 )  )**2 
    126                zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost 
    127                pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
    128             END DO 
    129          END DO 
     124            zcd = (  vkarmn / LOG( zzz / pz0 )  )**2 
     125            zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost 
     126            pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
     127         END_2D 
    130128      ELSE                                            !==  standard Cd  ==! 
    131          DO jj = 2, jpjm1 
    132             DO ji = 2, jpim1 
    133                imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    134                zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point 
    135                zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 
    136                !                                                           ! here pCd0 = mask*boost * drag 
    137                pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
    138             END DO 
    139          END DO 
     129         DO_2D_00_00 
     130            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
     131            zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point 
     132            zvt = vv(ji,jj,imk,Nii) + vv(ji,jj-1,imk,Nii) 
     133            !                                                           ! here pCd0 = mask*boost * drag 
     134            pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
     135         END_2D 
    140136      ENDIF 
    141137      ! 
     
    177173      ENDIF 
    178174 
    179       DO jj = 2, jpjm1 
    180          DO ji = 2, jpim1 
    181             ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
    182             ikbv = mbkv(ji,jj) 
     175      DO_2D_00_00 
     176         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
     177         ikbv = mbkv(ji,jj) 
     178         ! 
     179         ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
     180         zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 
     181         zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 
     182         ! 
     183         pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
     184         pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
     185      END_2D 
     186      ! 
     187      IF( ln_isfcav ) THEN        ! ocean cavities 
     188         DO_2D_00_00 
     189            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
     190            ikbv = mikv(ji,jj) 
    183191            ! 
    184192            ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    185             zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 
    186             zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 
     193            zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked 
     194            zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 
    187195            ! 
    188196            pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    189197            pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
    190          END DO 
    191       END DO 
    192       ! 
    193       IF( ln_isfcav ) THEN        ! ocean cavities 
    194          DO jj = 2, jpjm1 
    195             DO ji = 2, jpim1 
    196                ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
    197                ikbv = mikv(ji,jj) 
    198                ! 
    199                ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    200                zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked 
    201                zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 
    202                ! 
    203                pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    204                pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
    205            END DO 
    206          END DO 
     198         END_2D 
    207199      ENDIF 
    208200      ! 
     
    442434            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    443435            ! 
    444             DO jj = 1, jpj                   ! pCd0 = mask (and boosted) logarithmic drag coef.  
    445                DO ji = 1, jpi 
    446                   zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
    447                   zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 
    448                   pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax 
    449                END DO 
    450             END DO 
     436            DO_2D_11_11 
     437               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
     438               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 
     439               pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax 
     440            END_2D 
    451441         ELSE                       !* Cd updated at each time-step ==> pCd0 = mask * boost 
    452442            IF(lwp) WRITE(numout,*) 
Note: See TracChangeset for help on using the changeset viewer.