# Changeset 13470

Ignore:
Timestamp:
2020-09-15T12:56:56+02:00 (4 months ago)
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

Unmodified
Removed
• ## NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90

 r13469 ! DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! !---------------------------------------------!
• ## NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90

 r13469 zzc = rhoi * r1_rdtice DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zsal = sv_i(ji,jj,jl) 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)  ) !                             !----------------------------------------------------- IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side

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

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

 r13469 END WHERE DO jl = 1, jpl DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & END DO DO jl = 1, jpl DO_3D_00_00( 1, nlay_i ) DO_3D( 0, 0, 0, 0, 1, nlay_i ) 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), & &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & END DO DO jl = 1, jpl DO_3D_00_00( 1, nlay_s ) DO_3D( 0, 0, 0, 0, 1, nlay_s ) 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), & &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & ! derive open water from ice concentration zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt ! ! Limitation of moments. DO_2D_00_11 DO_2D( 0, 0, 1, 1 ) !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise) psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) !  Calculate fluxes and moments between boxes i<-->i+1 DO_2D_00_11 DO_2D( 0, 0, 1, 1 ) zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) END_2D DO_2D_00_10 DO_2D( 0, 0, 1, 0 ) zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) zalg  (ji,jj) = zalf END_2D DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =       zbet(ji-1,jj) zbt1 = 1.0 - zbet(ji-1,jj) !   Put the temporary moments into appropriate neighboring boxes. DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =       zbet(ji-1,jj) zbt1 = 1.0 - zbet(ji-1,jj) END_2D DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =       zbet(ji,jj) zbt1 = 1.0 - zbet(ji,jj) ! ! Limitation of moments. DO_2D_11_00 DO_2D( 1, 1, 0, 0 ) !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) !  Calculate fluxes and moments between boxes j<-->j+1 DO_2D_11_00 DO_2D( 1, 1, 0, 0 ) zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) END_2D ! DO_2D_10_00 DO_2D( 1, 0, 0, 0 ) zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) zalg  (ji,jj) = zalf !  Readjust moments remaining in the box. DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =         zbet(ji,jj-1) zbt1 = ( 1.0 - zbet(ji,jj-1) ) !   Put the temporary moments into appropriate neighboring boxes. DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =       zbet(ji,jj-1) zbt1 = 1.0 - zbet(ji,jj-1) END_2D DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zbt  =       zbet(ji,jj) zbt1 = 1.0 - zbet(ji,jj) ! DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( pv_i(ji,jj,jl) > 0._wp ) THEN ! !                                           ! -- check e_i/v_i -- ! DO jl = 1, jpl DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) IF ( pv_i(ji,jj,jl) > 0._wp ) THEN ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean !                                           ! -- check e_s/v_s -- ! DO jl = 1, jpl DO_3D_11_11( 1, nlay_s ) DO_3D( 1, 1, 1, 1, 1, nlay_s ) IF ( pv_s(ji,jj,jl) > 0._wp ) THEN ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean ! -- check snow load -- ! DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( pv_i(ji,jj,jl) > 0._wp ) THEN !

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

 r13469 npti = 0   ;   nptidx(:) = 0 ipti = 0   ;   iptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( at_i(ji,jj) > epsi10 ) THEN npti           = npti + 1 !                              !--------------------------------------------------! CASE( 1 )               !--- Spatial smoothing DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & END_2D DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) strength(ji,jj) = zworka(ji,jj) END_2D ENDIF ! DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN itframe = 1 ! number of time steps for the running mean

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

 r13469 ! select ice covered grid points npti = 0 ; nptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( zht_i_ini(ji,jj) > 0._wp ) THEN npti         = npti  + 1 CALL ice_var_salprof ! for sz_i DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) ! DO jl = 1, jpl DO_3D_11_11( 1, nlay_s ) DO_3D( 1, 1, 1, 1, 1, nlay_s ) t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & ! DO jl = 1, jpl DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
• ## NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90

 r13469 ! npti = 0   ;   nptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( at_i(ji,jj) > epsi10 ) THEN npti = npti + 1 !                    !--------------------------------------- npti = 0   ;   nptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN npti = npti + 1 !                    !----------------------------------------- npti = 0 ; nptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) 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 npti = npti + 1
• ## NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90

 r13469 IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 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 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zfric(ji,jj) = rn_cio * ( 0.5_wp *  & &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & END_2D ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & ! Partial computation of forcing for the thermodynamic sea ice model !--------------------------------------------------------------------! DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice ! ! select ice covered grid points npti = 0 ; nptidx(:) = 0 DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF ( a_i(ji,jj,jl) > epsi10 ) THEN npti         = npti  + 1
• ## NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90

 r13469 ENDIF DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! Solar heat flux reaching the ocean = zqsr (W.m-2) ! IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) !                                               ! 2*(U_ice-U_oce) at T-point zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ENDIF ! DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) ! ice area at u and v-points 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 zlay_i   = REAL( nlay_i , wp )    ! number of layers DO jl = 1, jpl DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area ! z1_dS = 1._wp / ( zsi1 - zsi0 ) DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) !                             ! force a constant profile when SSS too low (Baltic Sea) ! Computation of the profile DO jl = 1, jpl DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) !                          ! linear profile with 0 surface value zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i ! Zap ice energy and use ocean heat to melt ice !----------------------------------------------------------------- DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) ! update exchanges with ocean 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 END_3D ! DO_3D_11_11( 1, nlay_s ) DO_3D( 1, 1, 1, 1, 1, nlay_s ) ! update exchanges with ocean 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 ! zap ice and snow volume, add water and salt to ocean !----------------------------------------------------------------- DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! update exchanges with ocean sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice ! zap ice energy and send it to the ocean !---------------------------------------- DO_3D_11_11( 1, nlay_i ) DO_3D( 1, 1, 1, 1, 1, nlay_i ) IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 END_3D ! DO_3D_11_11( 1, nlay_s ) DO_3D( 1, 1, 1, 1, 1, nlay_s ) IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 ! zap ice and snow volume, add water and salt to ocean !----------------------------------------------------- DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 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 ! tresholds for outputs DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less END_2D DO jl = 1, jpl DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) ! IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) z2da  = u_ice(ji,jj) + u_ice(ji-1,jj) z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
• ## NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90

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

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

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

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

 r13469 !!---------------------------------------------------------------------------------- ! DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! zw  = pw10(ji,jj) REAL(wp) :: zzeta, zx2, zx, zpsi_unst, zpsi_stab,  zstab   ! local scalars !!---------------------------------------------------------------------------------- DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zzeta = pzeta(ji,jj) !!---------------------------------------------------------------------------------- ! DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! zzeta = pzeta(ji,jj) !!------------------------------------------------------------------- ! DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) ! zqa = (1._wp + rctv0*pqa(ji,jj))
• ## NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90

 r13469 ! IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) ! => need to be done only when otx1 was changed IF( llnewtx ) THEN DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) IF( llnewtau ) THEN zcoef = 1. / ( zrhoa * zcdrag ) DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) END_2D p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) CASE( 'T' ) DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) SELECT CASE( TRIM( sn_snd_crt%cldes ) ) CASE( 'oce only'             )      ! C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) ) zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji  ,jj-1,1,Nii) ) END_2D CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj) zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj) CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   & &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) CASE( 'oce only'             )      ! C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj  ,1,Nii) ) zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji , jj-1,1,Nii) ) END_2D CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj) zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Nii) + vv   (ji  ,jj-1,1,Nii) ) * zfr_l(ji,jj) CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. ) CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Nii) + uu   (ji-1,jj  ,1,Nii) ) * zfr_l(ji,jj)   & &         + 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 ! IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) imk = k_mk(ji,jj)          ! ocean bottom level at t-points zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point END_2D ELSE                                            !==  standard Cd  ==! DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) imk = k_mk(ji,jj)    ! ocean bottom level at t-points zut = uu(ji,jj,imk,Nii) + uu(ji-1,jj,imk,Nii)     ! 2 x velocity at t-point ENDIF DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels ikbv = mbkv(ji,jj) ! IF( ln_isfcav ) THEN        ! ocean cavities DO_2D_00_00 DO_2D( 0, 0, 0, 0 ) ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels ikbv = mikv(ji,jj) l_log_not_linssh = .FALSE.    !- don't update Cd at each time step ! DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2

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

 r13469 ! Chemistry is supposed to be fast enough to be at equilibrium ! ------------------------------------------------------------ DO_3D_11_11( 1, jpkm1 ) DO_3D( 1, 1, 1, 1, 1, jpkm1 ) zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) zkeq            = fekeq(ji,jj,jk) zdust = 0.         ! if no dust available DO_3D_11_11( 1, jpkm1 ) DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). IF( ln_ligand ) THEN ! DO_3D_11_11( 1, jpkm1 ) DO_3D( 1, 1, 1, 1, 1, jpkm1 ) zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
• ## NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90

 r13469 CALL fld_read( kt, 1, sf_river ) IF( ln_p4z ) THEN DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & END_2D ELSE    !  ln_p5z DO_2D_11_11 DO_2D( 1, 1, 1, 1 ) zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) DO_3D_00_00( 1, ik50 ) DO_3D( 0, 0, 0, 0, 1, ik50 ) ze3t   = e3t_0(ji,jj,jk) zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) ! DO_3D_11_11( 1, jpk ) DO_3D( 1, 1, 1, 1, 1, jpk ) zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 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 xnegtr(:,:,:) = 1.e0 DO jn = jp_pcs0, jp_pcs1 DO_3D_11_11( 1, jpk ) DO_3D( 1, 1, 1, 1, 1, jpk ) IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )