# Changeset 5737

Ignore:
Timestamp:
2015-09-13T09:42:41+02:00 (5 years ago)
Message:

#1593: LDF-ADV, step I: Phasing of horizontal scale factors correct 2

Location:
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
Files:
59 edited

### Legend:

Unmodified
Removed

 r5429 !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise) psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) !  Calculate fluxes and moments between boxes i<-->i+1 !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) !  Calculate fluxes and moments between boxes j<-->j+1

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

 r5167 WRITE(numout,*) ' - Cell values ' WRITE(numout,*) '   ~~~~~~~~~~~ ' WRITE(numout,*) ' cell area     : ', e12t(ji,jj) WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) WRITE(numout,*) ' at_i          : ', at_i(ji,jj) WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj) WRITE(numout,*) ' - Cell values ' WRITE(numout,*) '   ~~~~~~~~~~~ ' WRITE(numout,*) ' cell area     : ', e12t(ji,jj) WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) WRITE(numout,*) ' at_i          : ', at_i(ji,jj) WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

 r5123 CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :') CALL prt_ctl(tab2d_1=e1e2t     , clinfo1=' lim_dyn  : cell area :') CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :')
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

 r5429 DO jj = 2, jpjm1 DO ji = fs_2 , fs_jpim1   ! vector opt. efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) END DO END DO DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes DO ji = fs_2 , fs_jpim1   ! vector opt. zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) END DO END DO DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes DO ji = fs_2 , fs_jpim1   ! vector opt. zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

 r5202 CALL prt_ctl_info(' - Cell values : ') CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :') CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_me  : cell area :') CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :')

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

 r5407 CALL prt_ctl_info(' - Cell values : ') CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd  : cell area :') CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') CALL prt_ctl_info(' - Cell values : ') CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :') CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th  : cell area :') CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

 r5202 ENDIF zsm(:,:) = e12t(:,:) zsm(:,:) = e1e2t(:,:) !                             !-------------------------------------! ! transported fields !------------------------- z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area DO jl = 1, jpl z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area DO jl = 1, jpl z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content DO jk = 1, nlay_i z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content END DO END DO ! Recover the properties from their contents !------------------------------------------- ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:) DO jl = 1, jpl v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:) v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:) smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:) oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:) a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:) e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:) ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) DO jl = 1, jpl v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:) DO jk = 1, nlay_i e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:) e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) END DO END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

 r5215 CALL prt_ctl_info(' - Cell values : ') CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :') CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :')
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

 r5410 CALL prt_ctl_info(' - Cell values : ') CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :') CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update2  : cell area   :') CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :') CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :')
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

 r5656 DO jj = j1,j2-1 DO ji = i1,i2-1 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) IF (.NOT. tabspongedone_tsn(ji,jj)) THEN zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) ! horizontal diffusive trends ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) DO jj = j1,j2 DO ji = i1+1,i2   ! vector opt. zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr DO jj = j1,j2-1 DO ji = i1,i2   ! vector opt. zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & DO jj = j1+1,j2 DO ji = i1,i2   ! vector opt. zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr DO jj = j1,j2 DO ji = i1,i2-1   ! vector opt. zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) &
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

 r5656 DO jj = j1,j2-1 DO ji = i1,i2-1 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) IF (.NOT. tabspongedone_trn(ji,jj)) THEN zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk) zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk) ! horizontal diffusive trends ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/domrea.F90

 r5385 zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

 r5541 + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) END DO END DO DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   & - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) & / e1u(ji,jj) * umask(ji,jj,jk) v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   & - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) & / e2v(ji,jj) * vmask(ji,jj,jk) u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & * r1_e1u(ji,jj) * umask(ji,jj,jk) v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & * r1_e2v(ji,jj) * vmask(ji,jj,jk) END DO END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

 r5643 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain ! ----------------------------------------------------------------------- z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

 r5253 IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) area(:,:) = e1e2t(:,:) * tmask_i(:,:) area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

 r5566 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. z2d(:,:) = rau0 * e12t(:,:) z2d(:,:) = rau0 * e1e2t(:,:) DO jk = 1, jpk z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) DO jj = 2, jpjm1                                    ! sst gradient DO ji = fs_2, fs_jpim1   ! vector opt. zztmp      = tsn(ji,jj,1,jp_tem) zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) zztmp  = tsn(ji,jj,1,jp_tem) 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  ) zztmpy = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji  ,jj-1) z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) clmx ="l_max(only(x))"    ! max index on a period CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) !         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX !            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) #if defined key_diahth CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1  ! vector opt. zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + & &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))*r1_e2v(ji,jj) + & &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))*r1_e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx END DO END DO

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

 r5603 PRIVATE PUBLIC dom_wri        ! routine called by inidom.F90 PUBLIC   dom_wri              ! routine called by inidom.F90 PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90 !! * Substitutions #  include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- CONTAINS SUBROUTINE dom_wri_coordinate !!---------------------------------------------------------------------- !!                  ***  ROUTINE dom_wri_coordinate  *** !! !! ** Purpose :   Create the NetCDF file which contains all the !!              standard coordinate information plus the surface, !!              e1e2u and e1e2v. By doing so, those surface will !!              not be changed by the reduction of e1u or e2v scale !!              factors in some straits. !!                 NB: call just after the read of standard coordinate !!              and the reduction of scale factors in some straits !! !! ** output file :   coordinate_e1e2u_v.nc !!---------------------------------------------------------------------- INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) !                                   !  workspaces REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv !!---------------------------------------------------------------------- ! IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate') ! IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations) !  create 'coordinate_e1e2u_v.nc' file ! ============================ ! CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) ! !                                                         ! horizontal mesh (inum3) CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) CALL iom_close( inum0 ) ! IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate') ! END SUBROUTINE dom_wri_coordinate SUBROUTINE dom_wri
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

 r5516 (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       & + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) END DO END DO DO ji = 1, fs_jpim1   ! vector opt. rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      & &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) END DO END DO ii = nicoa(jl,1,jk) ij = njcoa(jl,1,jk) rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   & * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) END DO DO jl = 1, npcoa(2,jk) ii = nicoa(jl,2,jk) ij = njcoa(jl,2,jk) rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   & *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * (-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) END DO DO jl = 1, npcoa(3,jk) ii = nicoa(jl,3,jk) ij = njcoa(jl,3,jk) rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) END DO DO jl = 1, npcoa(4,jk) ii = nicoa(jl,4,jk) ij = njcoa(jl,4,jk) rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) END DO !                                             ! =============== (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       & + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) END DO END DO rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) ) &           * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) END DO END DO

 r4990 DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes DO ji = fs_2, fs_jpim1   ! vector opt. zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) ! ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & DO jk = 1, jpkm1                       ! ==================== ! !                                         ! Vertical volume fluxesÊ zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) ! IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes DO ji = fs_2, fs_jpim1   ! vector opt. ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) END DO END DO

 r5069 DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes DO ji = fs_2, fs_jpim1   ! vector opt. zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) ! ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & DO jk = 1, jpkm1                       ! ==================== ! !                                         ! Vertical volume fluxesÊ zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) ! IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes DO ji = fs_2, fs_jpim1   ! vector opt. ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) END DO END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

 r5224 DO jj = 2, jpjm1 DO ji = 2, jpim1 zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * & & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * & & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * & & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * & & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp END DO END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

 r4990 DO ji = fs_2, fs_jpim1   ! vector opt. zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) * r1_e1u(ji,jj) zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) * r1_e2v(ji,jj) END DO END DO DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj) zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj) zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) * r1_e2u(ji,jj)   & &            + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) * r1_e1u(ji,jj) zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) * r1_e1v(ji,jj)   & &            + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) * r1_e2v(ji,jj) END DO END DO DO ji = 1, fs_jpim1   ! vector opt. zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      & &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   & &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) &                               - zcu(ji  ,jj+1) + zcu(ji,jj)  )   & &       * fse3f(ji,jj,jk) * r1_e1e2f(ji,jj) END DO END DO DO jj = 2, jpj DO ji = fs_2, jpi   ! vector opt. zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   & &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt ! horizontal biharmonic diffusive trends zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   & &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj) &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) * r1_e1u(ji,jj) zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   & &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj) &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) * r1_e2v(ji,jj) ! add it to the general momentum trends ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

 r4990 ! horizontal diffusive trends zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj) + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) * r1_e1u(ji,jj) zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj) + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) * r1_e2v(ji,jj) ! add it to the general momentum trends

• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

 r5029 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. !!---------------------------------------------------------------------- ! INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; zfact2 = 0.5 * 0.5      ! Local constant initialization !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) !                                                ! =============== DO jk = 1, jpkm1                                 ! Horizontal slab zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) &     * 0.5 * r1_e1e2f(ji,jj) END DO END DO &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & &       * 0.5 * r1_e1e2f(ji,jj)                                              & &       ) END DO zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) END DO END DO zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) ) &       * 0.5 / ( e1e2f (ji,jj) * fse3f(ji,jj,jk) ) END DO END DO zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) ) &       * 0.5 * r1_e1e2f(ji,jj) END DO END DO DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj) zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj) zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) ! enstrophy conserving formulation for relative vorticity term zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 ) zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) &     * 0.5 * r1_e1e2f(ji,jj) END DO END DO &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & &       * 0.5 * r1_e1e2f(ji,jj)                                                & &       ) END DO END SELECT ! IF( ln_sco ) THEN DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk) zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) END DO END DO IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) ELSE DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk) zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk) END DO END DO ENDIF ! ! Compute and add the vorticity term trend ! ---------------------------------------- zwx(:,:) = e2u(:,:) * un(:,:,jk) zwy(:,:) = e1v(:,:) * vn(:,:,jk) ENDIF !                                   !==  compute and add the vorticity term trend  =! DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) zuav = zfact1 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & &                            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) zvau =-zfact1 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & &                            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 !!---------------------------------------------------------------------- ! INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; zfac12 = 1._wp / 12._wp    ! Local constant initialization !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) !                                                ! =============== DO jk = 1, jpkm1                                 ! Horizontal slab zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) &     * 0.5 * r1_e1e2f(ji,jj) * ze3f(ji,jj,jk) END DO END DO &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & &       ) * ze3f(ji,jj,jk) &       * 0.5 * r1_e1e2f(ji,jj)   ) * ze3f(ji,jj,jk) END DO END DO CALL lbc_lnk( zwz, 'F', 1. ) END SELECT ! !                                   !==  horizontal fluxes  ==! zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) ! Compute and add the vorticity term trend ! ---------------------------------------- !                                   !==  compute and add the vorticity term trend  =! jj = 2 ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 DO ji = 2, jpi DO ji = 2, jpi          ! split in 2 parts due to vector opt. ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & zua = + zfac12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & zva = - zfac12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) pua(ji,jj,jk) = pua(ji,jj,jk) + zua

 r5120 DO jj = 2, jpj                   ! vertical fluxes DO ji = fs_2, jpi             ! vector opt. zww(ji,jj) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) END DO END DO DO ji = fs_2, fs_jpim1       ! vector opt. !                         ! vertical momentum advective trends zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) !                         ! add the trends to the general momentum trends ua(ji,jj,jk) = ua(ji,jj,jk) + zua ! END SUBROUTINE dyn_zad SUBROUTINE dyn_zad_zts ( kt ) DO jj = 2, jpj DO ji = fs_2, jpi             ! vector opt. zww(ji,jj,jk) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) END DO END DO DO ji = fs_2, fs_jpim1       ! vector opt. !                         ! vertical momentum advective trends zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

 r5656 DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) END DO END DO
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

 r4328 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl)) zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl)) zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl))
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

 r5215 nbergs_end        = icb_utl_count() zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) ) zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

 r5215 ! use tmask rather than tmask_i when dealing with icebergs IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics z1_e1e2    = 1._wp / e1e2t(ii,ij) * this%mass_scaling z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling z1_dt_e1e2 = z1_dt * z1_e1e2 zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s ! ELSE                            ! Diagnose mass distribution on grid z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   & &                  this%mass_scaling, zMnew, znMbits, z1_e1e2)
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

 r5656 ! IF( ln_cfmeta ) THEN   ! Add additional grid metadata CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

 r5407 END SUBROUTINE rst_read_open SUBROUTINE rst_read !!---------------------------------------------------------------------- hdivb(:,:,:)   = hdivn(:,:,:) sshb (:,:)     = sshn (:,:) ! IF( lk_vvl ) THEN DO jk = 1, jpk END DO ENDIF ! ENDIF !
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

 r3294 USE lib_mpp          ! MPP library USE dom_oce, ONLY : &                  ! Domain variables &                    tmask, tmask_i, e1t, e2t, gphit, glamt &                    tmask, tmask_i, e1e2t, gphit, glamt USE obs_const, ONLY :   obfillflt      ! Fillvalue USE oce      , ONLY :   sshn           ! Model variables DO jj = 1, jpj DO ji = 1, jpi zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj) zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) zarea = zarea + zdxdy zeta1 = zeta1 + mdt(ji,jj) * zdxdy
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

 r5516 PRIVATE !! * Routine accessibility PUBLIC cice_sbc_init   ! routine called by sbc_init PUBLIC cice_sbc_final  ! routine called by sbc_final !! * Substitutions #  include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.7 , NEMO-consortium (2015) !! \$Id\$ !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS END SUBROUTINE sbc_ice_cice SUBROUTINE cice_sbc_init (ksbc) SUBROUTINE cice_sbc_init( ksbc ) !!--------------------------------------------------------------------- !!                    ***  ROUTINE cice_sbc_init  *** !! ** Purpose: Initialise ice related fields for NEMO and coupling !! !!--------------------------------------------------------------------- INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 SUBROUTINE cice_sbc_in (kt, ksbc) SUBROUTINE cice_sbc_in( kt, ksbc ) !!--------------------------------------------------------------------- !!                    ***  ROUTINE cice_sbc_in  *** INTEGER, INTENT(in   ) ::   kt   ! ocean time step INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type ! INTEGER  ::   ji, jj, jl                   ! dummy loop indices REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice ! x comp and y comp of sea surface slope (on F points) ! T point to F point DO jj=1,jpjm1 DO ji=1,jpim1 ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & *  fmask(ji,jj,1) ENDDO ENDDO CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) DO jj = 1, jpjm1 DO ji = 1, jpim1 ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    & &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1) END DO END DO CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) ! T point to F point DO jj=1,jpjm1 DO ji=1,jpim1 ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & *  fmask(ji,jj,1) ENDDO ENDDO DO jj = 1, jpjm1 DO ji = 1, jpim1 ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    & &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1) END DO END DO CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) SUBROUTINE cice_sbc_out (kt,ksbc) SUBROUTINE cice_sbc_out( kt, ksbc ) !!--------------------------------------------------------------------- !!                    ***  ROUTINE cice_sbc_out  *** ! Update taum with modulus of ice-ocean stress ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) ! Freshwater fluxes #endif !!--------------------------------------------------------------------- CHARACTER(len=1), INTENT( in ) ::   & cd_type       ! nature of pn grid-point INTEGER  ::   ji, jj, jn                      ! dummy loop indices !!--------------------------------------------------------------------- !     A. Ensure all haloes are filled in NEMO field (pn) !!   Default option           Dummy module         NO CICE sea-ice model !!---------------------------------------------------------------------- !! \$Id\$ CONTAINS
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

 r5541 DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) *  fse3t(ji,jj,jk) ) ! advective trends ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &

 r5656 END DO # if defined key_diaeiv IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) ) IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1e2t(:,:) ) # endif ENDIF

 r5215 PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90 !                                               !!* namelist namtra_adv_mle * !                                       !!* namelist namtra_adv_mle * LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE REAL(wp)        ::   rn_ce               ! MLE coefficient !                                           ! parameters used in nn_mle = 0 case !                                        ! parameters used in nn_mle = 0 case REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front REAL(wp)        ::   rn_time             ! time scale for mixing momentum across the mixed layer !                                             ! parameters used in nn_mle = 1 case REAL(wp)        ::   rn_lat                   ! reference latitude for a 5 km scale of ML front REAL(wp)        ::   rn_rho_c_mle         ! Density criterion for definition of MLD used by FK REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer !                                        ! parameters used in nn_mle = 1 case REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation #  include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 4.0 , NEMO Consortium (2011) !! NEMO/OPA 4.0 , NEMO Consortium (2015) !! \$Id\$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 !!---------------------------------------------------------------------- ! INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index REAL(wp) ::   zcvw, zmvw   !   -      - REAL(wp) ::   zc                                     !   -      - ! INTEGER  ::   ii, ij, ik              ! local integers INTEGER, DIMENSION(3) ::   ilocu      ! INTEGER, POINTER, DIMENSION(:,:) :: inml_mle !!---------------------------------------------------------------------- ! IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle') CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) DO jj = 1, jpjm1 DO ji = 1, fs_jpim1   ! vector opt. zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e1u(ji,jj)                )   & &           / (         e1u(ji,jj)          * MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) ! zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            & &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e2v(ji,jj)                )   & &           / (         e2v(ji,jj)          * MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) END DO END DO DO jj = 1, jpjm1 DO ji = 1, fs_jpim1   ! vector opt. zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj) / e1u(ji,jj)          & zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) ! zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj) / e2v(ji,jj)          & zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) END DO ! divide by cross distance to give streamfunction with dimensions m^2/s DO jk = 1, ikmax+1 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk)/e2u(:,:) zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk)/e1v(:,:) zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:) zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:) END DO CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle !!---------------------------------------------------------------------- REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme

 r5147 z0u = SIGN( 0.5, pun(ji,jj,jk) ) zalpha = 0.5 - z0u zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) z0v = SIGN( 0.5, pvn(ji,jj,jk) ) zalpha = 0.5 - z0v zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! horizontal advective trends ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) zalpha = 0.5 + z0w

 r5147 z0u = SIGN( 0.5, pun(ji,jj,jk) ) zalpha = 0.5 - z0u zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk) z0v = SIGN( 0.5, pvn(ji,jj,jk) ) zalpha = 0.5 - z0v zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! horizontal advective trends ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) zalpha = 0.5 + z0w DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! vertical advective trends ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )

 r5147 DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! horizontal advective trends ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! horizontal advective trends ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! k- vertical advective trends ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )

 r5147 DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! total intermediate advective trends ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! total advective trends ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & END SUBROUTINE tra_adv_tvd SUBROUTINE tra_adv_tvd_zts ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & &                                       ptb, ptn, pta, kjpt ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! total intermediate advective trends ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! total advective trends ztra = - zbtr * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) ! total advective trends ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & END SUBROUTINE tra_adv_tvd_zts SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) !!---------------------------------------------------------------------

 r5147 DO jj = 1, jpjm1            ! First derivative (gradient) DO ji = 1, fs_jpim1   ! vector opt. zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

 r4990 USE phycst         ! physical constant USE eosbn2         ! equation of state USE trd_oce     ! trends: ocean variables USE trd_oce        ! trends: ocean variables USE trdtra         ! trends: active tracers ! DO jj = 1, jpj DO ji = 1, jpi ik = mbkt(ji,jj)                              ! bottom T-level index zptb(ji,jj) = ptb(ji,jj,ik,jn)       ! bottom before T and S ik = mbkt(ji,jj)                             ! bottom T-level index zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S END DO END DO DO jj = 2, jpjm1                                    ! Compute the trend DO ji = 2, jpim1 ik = mbkt(ji,jj)                              ! bottom T-level index zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   & &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   & &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr ik = mbkt(ji,jj)                            ! bottom T-level index pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & &             / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) END DO END DO ! !                                               ! up  -slope T-point (shelf bottom point) zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus) zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra ! DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,jk) zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra END DO ! zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,ikud) zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra ! ! up  -slope T-point (shelf bottom point) zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs) zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra ! DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,jk) zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra END DO !                                               ! down-slope T-point (deep bottom point) zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,ikvd) zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra !                             !* masked diffusive flux coefficients ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:) * umask(:,:,1) ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

 r5147 DO jj = 1, jpjm1 DO ji = 1, fs_jpim1   ! vector opt. zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk) zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk) zeeu(ji,jj) = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk) zeev(ji,jj) = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk) END DO END DO DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   ) DO ji = fs_2, fs_jpim1   ! vector opt. ! horizontal diffusive trends zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) ! add it to the general tracer trends
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

 r5147 DO jj = 1, jpjm1 DO ji = 1, jpim1 zabe1 = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) zabe1 = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   & DO jk = 2, jpkm1 DO ji = 2, jpim1 zcof0 = e12t(ji,jj) / fse3w_n(ji,jj,jk)   & zcof0 = e1e2t(ji,jj) / fse3w_n(ji,jj,jk)   & &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        & &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) DO ji = 2, jpim1 ! eddy coef. divided by the volume element zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) ! vertical divergence ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) ) DO ji = 2, jpim1 ! inverse of the volume element zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) ! vertical divergence ztav = zftw(ji,jk) - zftw(ji,jk+1)
• ## branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

 r5149 DO jj = 1 , jpjm1 DO ji = 1, fs_jpim1   ! vector opt. zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) ! zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & DO jj = 2 , jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1   ! vector opt. zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra