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 5845 for branches – NEMO

Changeset 5845 for branches


Ignore:
Timestamp:
2015-10-31T08:40:45+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default: suppression of domzgr_substitute.h90

Location:
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM
Files:
2 deleted
171 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5836 r5845  
    12681268   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    12691269/ 
    1270 !----------------------------------------------------------------------- 
    1271 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    1272 !----------------------------------------------------------------------- 
    1273    ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
    1274    ln_neptsimp       = .false.  ! yes/no use simplified neptune 
    1275  
    1276    ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
    1277    rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
    1278    rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
    1279    ! Specify whether to ramp down the Neptune velocity in shallow 
    1280    ! water, and if so the depth range controlling such ramping down 
    1281    ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water 
    1282    rn_htrmin         =  100.0   ! min. depth of transition range 
    1283    rn_htrmax         =  200.0   ! max. depth of transition range 
    1284 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r5836 r5845  
    5858   !! * Substitutions 
    5959#  include "vectopt_loop_substitute.h90" 
    60 #  include "domzgr_substitute.h90" 
    6160   !!---------------------------------------------------------------------- 
    6261   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
     
    471470         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    472471         do jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    473           fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    474           fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     472          e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     473          e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    475474         end do 
    476          fse3t_a(:,:,:) = fse3t_b(:,:,:) 
     475         e3t_a(:,:,:) = e3t_b(:,:,:) 
    477476         ! Reconstruction of all vertical scale factors at now and before time steps 
    478477         ! ============================================================================= 
    479478         ! Horizontal scale factor interpolations 
    480479         ! -------------------------------------- 
    481          CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
    482          CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
    483          CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
    484          CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
    485          CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 
     480         CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
     481         CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     482         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     483         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     484         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    486485         ! Vertical scale factor interpolations 
    487486         ! ------------------------------------ 
    488          CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
    489          CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
    490          CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
    491          CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
    492          CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
     487         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
     488         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
     489         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     490         CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     491         CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
    493492         ! t- and w- points depth 
    494493         ! ---------------------- 
    495          fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
    496          fsdepw_n(:,:,1) = 0.0_wp 
    497          fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
     494         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     495         gdepw_n(:,:,1) = 0.0_wp 
     496         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    498497         DO jk = 2, jpk 
    499             fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
    500             fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
    501             fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
     498            gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
     499            gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
     500            gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
    502501         END DO 
    503502      ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r5836 r5845  
    4747 
    4848   !! * Substitutions 
    49 #  include "domzgr_substitute.h90" 
    5049#  include "vectopt_loop_substitute.h90" 
    5150   !!-------- ------------------------------------------------------------- 
     
    233232             
    234233            !  energy needed to bring ocean surface layer until its freezing 
    235             qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) 
     234            qcmif  (ji,jj) =  rau0 * rcp * e3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) 
    236235             
    237236            !  calculate oceanic heat flux. 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5407 r5845  
    5757   !! * Substitutions 
    5858#  include "vectopt_loop_substitute.h90" 
    59 #  include "domzgr_substitute.h90" 
    6059   !!---------------------------------------------------------------------- 
    6160   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    335334            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    336335            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     336 
    337337#if defined key_vvl             
    338            ! key_vvl necessary? clem: yes for compilation purpose 
     338!!gm key_vvl necessary? clem: yes for compilation purpose 
     339!!gm I really don't like this staff here...  Find a way to put that elsewhere or differently 
    339340            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    340                fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    341                fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    342             ENDDO 
    343             fse3t_a(:,:,:) = fse3t_b(:,:,:) 
     341               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     342               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     343            END DO 
     344            e3t_a(:,:,:) = e3t_b(:,:,:) 
    344345            ! Reconstruction of all vertical scale factors at now and before time 
    345346            ! steps 
     
    347348            ! Horizontal scale factor interpolations 
    348349            ! -------------------------------------- 
    349             CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
    350             CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
    351             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
    352             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
    353             CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 
     350            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
     351            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     352            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     353            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     354            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    354355            ! Vertical scale factor interpolations 
    355356            ! ------------------------------------ 
    356             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
    357             CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
    358             CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
    359             CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
    360             CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
     357            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
     358            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
     359            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     360            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     361            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
    361362            ! t- and w- points depth 
    362363            ! ---------------------- 
    363             fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
    364             fsdepw_n(:,:,1) = 0.0_wp 
    365             fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
     364!!gm not sure of that.... 
     365            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     366            gdepw_n(:,:,1) = 0.0_wp 
     367            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    366368            DO jk = 2, jpk 
    367                fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
    368                fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
    369                fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
     369               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
     370               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
     371               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
    370372            END DO 
    371373#endif 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5836 r5845  
    5252 
    5353   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5554#  include "vectopt_loop_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
     
    147146 
    148147            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    149             zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     148            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    150149 
    151150            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r5656 r5845  
    4646# endif 
    4747 
    48 #  include "domzgr_substitute.h90"   
    4948#  include "vectopt_loop_substitute.h90" 
    5049   !!---------------------------------------------------------------------- 
     
    7675      !!                  ***  ROUTINE Agrif_DYN  *** 
    7776      !!----------------------------------------------------------------------   
    78       !!  
    7977      INTEGER, INTENT(in) ::   kt 
    80       !! 
     78      ! 
    8179      INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    8280      REAL(wp) :: timeref 
     
    137135         DO jk=1,jpkm1 
    138136            DO jj=1,jpj 
    139                spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     137               spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    140138            END DO 
    141139         END DO 
     
    143141         DO jj=1,jpj 
    144142            IF (umask(2,jj,1).NE.0.) THEN 
    145                spgu(2,jj)=spgu(2,jj)/hu(2,jj) 
     143               spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 
    146144            ENDIF 
    147145         END DO 
     
    161159         DO jk=1,jpkm1 
    162160            DO jj=1,jpj 
    163                spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     161               spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    164162            END DO 
    165163         END DO 
     
    167165         DO jj=1,jpj 
    168166            IF (umask(2,jj,1).NE.0.) THEN 
    169                spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 
     167               spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 
    170168            ENDIF 
    171169         END DO 
     
    182180         DO jk=1,jpkm1 
    183181            DO jj=1,jpj 
    184                spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk) 
     182               spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 
    185183            END DO 
    186184         END DO 
    187185         DO jj=1,jpj 
    188             spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 
     186            spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 
    189187         END DO 
    190188         DO jk=1,jpkm1 
     
    207205         DO jk=1,jpkm1 
    208206            DO jj=1,jpj 
    209                spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
     207               spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    210208            ENDDO 
    211209         ENDDO 
    212210         DO jj=1,jpj 
    213211            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    214                spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 
     212               spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    215213            ENDIF 
    216214         END DO 
     
    229227         DO jk=1,jpkm1 
    230228            DO jj=1,jpj 
    231                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
     229               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
    232230            END DO 
    233231         END DO 
    234232         DO jj=1,jpj 
    235233            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    236                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 
     234               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    237235            ENDIF 
    238236         END DO 
     
    248246         DO jk=1,jpkm1 
    249247            DO jj=1,jpj 
    250                spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
     248               spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
    251249            END DO 
    252250         END DO 
    253251 
    254252         DO jj=1,jpj 
    255             spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj) 
     253            spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 
    256254         END DO 
    257255 
     
    278276         DO jk=1,jpkm1 
    279277            DO ji=1,jpi 
    280                spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 
     278               spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 
    281279            END DO 
    282280         END DO 
     
    284282         DO ji=1,jpi 
    285283            IF (vmask(ji,2,1).NE.0.) THEN 
    286                spgv(ji,2)=spgv(ji,2)/hv(ji,2) 
     284               spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 
    287285            ENDIF 
    288286         END DO 
     
    302300         DO jk=1,jpkm1 
    303301            DO ji=1,jpi 
    304                spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
     302               spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    305303            END DO 
    306304         END DO 
     
    308306         DO ji=1,jpi 
    309307            IF (vmask(ji,2,1).NE.0.) THEN 
    310                spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 
     308               spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 
    311309            ENDIF 
    312310         END DO 
     
    323321         DO jk=1,jpkm1 
    324322            DO ji=1,jpi 
    325                spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
     323               spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
    326324            END DO 
    327325         END DO 
    328326 
    329327         DO ji=1,jpi 
    330             spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2) 
     328            spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 
    331329         END DO 
    332330 
     
    353351         DO jk=1,jpkm1 
    354352            DO ji=1,jpi 
    355                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     353               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    356354            END DO 
    357355         END DO 
     
    359357         DO ji=1,jpi 
    360358            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    361                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 
     359               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    362360            ENDIF 
    363361         END DO 
     
    378376         DO jk=1,jpkm1 
    379377            DO ji=1,jpi 
    380                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     378               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    381379            END DO 
    382380         END DO 
     
    384382         DO ji=1,jpi 
    385383            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    386                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 
     384               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    387385            ENDIF 
    388386         END DO 
     
    399397         DO jk=1,jpkm1 
    400398            DO ji=1,jpi 
    401                spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
     399               spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
    402400            END DO 
    403401         END DO 
    404402 
    405403         DO ji=1,jpi 
    406             spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1) 
     404            spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 
    407405         END DO 
    408406 
     
    812810               DO ji=i1,i2 
    813811                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    814                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 
     812                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 
    815813               END DO 
    816814            END DO 
     
    821819            DO jj=j1,j2 
    822820               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
    823                ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 
     821               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 
    824822            END DO 
    825823         END DO 
     
    880878               DO ji=i1,i2 
    881879                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    882                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 
     880                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 
    883881               END DO 
    884882            END DO 
     
    889887            DO jj=j1,j2 
    890888               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
    891                va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 
     889               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 
    892890            END DO 
    893891         END DO 
     
    944942         DO jj=j1,j2 
    945943            DO ji=i1,i2 
    946                ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
     944               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj)  
    947945            END DO 
    948946         END DO 
     
    10211019         DO jj=j1,j2 
    10221020            DO ji=i1,i2 
    1023                ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)  
     1021               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj)  
    10241022            END DO 
    10251023         END DO 
     
    12091207                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    12101208                     ENDIF 
    1211                      WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
     1209                     WRITE(numout,*) '      ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    12121210                     kindic_agr = kindic_agr + 1 
    12131211                  ENDIF 
     
    12191217      !  
    12201218   END SUBROUTINE interpe3t 
     1219 
    12211220 
    12221221   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r5836 r5845  
    1717   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 
    1818 
    19    !! * Substitutions 
    20 #  include "domzgr_substitute.h90" 
    2119   !!---------------------------------------------------------------------- 
    2220   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     
    210208               DO jj = j1,j2-1 
    211209                  DO ji = i1,i2-1 
    212                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    213                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     210                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     211                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    214212                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    215213                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     
    239237 
    240238                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    241                         zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) 
     239                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    242240                        ! horizontal diffusive trends 
    243241                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) 
     
    290288            DO jj = j1,j2 
    291289               DO ji = i1+1,i2   ! vector opt. 
    292                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    293                   hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
    294                                      &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     290                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     291                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
     292                                     &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
    295293               END DO 
    296294            END DO 
     
    298296            DO jj = j1,j2-1 
    299297               DO ji = i1,i2   ! vector opt. 
    300                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     298                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    301299                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 
    302300                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &  
     
    318316                     ze1v = hdivdiff(ji,jj,jk) 
    319317                     ! horizontal diffusive trends 
    320                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   & 
     318                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   & 
    321319                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj) 
    322320 
     
    344342 
    345343                     ! horizontal diffusive trends 
    346                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   & 
     344                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
    347345                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj) 
    348346 
     
    396394            DO jj = j1+1,j2 
    397395               DO ji = i1,i2   ! vector opt. 
    398                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    399                   hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
    400                                      &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     396                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     397                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
     398                                     &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
    401399               END DO 
    402400            END DO 
    403401            DO jj = j1,j2 
    404402               DO ji = i1,i2-1   ! vector opt. 
    405                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     403                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    406404                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    407405                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
     
    424422                     ze1v = hdivdiff(ji,jj,jk) 
    425423                     ! horizontal diffusive trends 
    426                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
     424                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
    427425                           / e1u(ji,jj) 
    428426 
     
    446444                     ! horizontal diffusive trends 
    447445 
    448                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
     446                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
    449447                           / e2v(ji,jj) 
    450448 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r5656 r5845  
    2626   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 
     
    6766      ! 
    6867   END SUBROUTINE Agrif_Update_Tra 
     68 
    6969 
    7070   RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
     
    153153 
    154154# if defined key_zdftke 
     155 
    155156   SUBROUTINE Agrif_Update_Tke( kt ) 
    156157      !!--------------------------------------------- 
     
    175176       
    176177   END SUBROUTINE Agrif_Update_Tke 
     178    
    177179# endif /* key_zdftke */ 
    178180 
     
    181183      !!           *** ROUTINE updateT *** 
    182184      !!--------------------------------------------- 
    183 #  include "domzgr_substitute.h90" 
    184185      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    185186      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     
    231232   END SUBROUTINE updateTS 
    232233 
     234 
    233235   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 
    234236      !!--------------------------------------------- 
    235237      !!           *** ROUTINE updateu *** 
    236238      !!--------------------------------------------- 
    237 #  include "domzgr_substitute.h90" 
    238       !! 
    239239      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    240240      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     
    250250            DO jj=j1,j2 
    251251               DO ji=i1,i2 
    252                   tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    253                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 
     252                  tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    254253               END DO 
    255254            END DO 
     
    260259            DO jj=j1,j2 
    261260               DO ji=i1,i2 
    262                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk) 
     261                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    263262                  ! 
    264263                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    275274   END SUBROUTINE updateu 
    276275 
     276 
    277277   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 
    278278      !!--------------------------------------------- 
    279279      !!           *** ROUTINE updatev *** 
    280280      !!--------------------------------------------- 
    281 #  include "domzgr_substitute.h90" 
    282       !! 
    283281      INTEGER :: i1,i2,j1,j2,k1,k2 
    284282      INTEGER :: ji,jj,jk 
     
    294292            DO jj=j1,j2 
    295293               DO ji=i1,i2 
    296                   tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    297                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 
     294                  tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    298295               END DO 
    299296            END DO 
     
    304301            DO jj=j1,j2 
    305302               DO ji=i1,i2 
    306                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk) 
     303                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
    307304                  ! 
    308305                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    319316   END SUBROUTINE updatev 
    320317 
     318 
    321319   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 
    322320      !!--------------------------------------------- 
    323321      !!          *** ROUTINE updateu2d *** 
    324322      !!--------------------------------------------- 
    325 #  include "domzgr_substitute.h90" 
    326       !! 
    327323      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    328324      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     
    338334         DO jj=j1,j2 
    339335            DO ji=i1,i2 
    340                tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj) 
     336               tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
    341337            END DO 
    342338         END DO 
     
    345341         DO jj=j1,j2 
    346342            DO ji=i1,i2 
    347                tabres(ji,jj) =  tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj)   
     343               tabres(ji,jj) =  tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj)   
    348344               !     
    349345               ! Update "now" 3d velocities: 
    350346               spgu(ji,jj) = 0.e0 
    351347               DO jk=1,jpkm1 
    352                   spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 
    353                END DO 
    354                spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj) 
     348                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     349               END DO 
     350               spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 
    355351               ! 
    356352               zcorr = tabres(ji,jj) - spgu(ji,jj) 
     
    371367               spgu(ji,jj) = 0.e0 
    372368               DO jk=1,jpkm1 
    373                   spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 
    374                END DO 
    375                spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj) 
     369                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 
     370               END DO 
     371               spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 
    376372               ! 
    377373               zcorr = ub_b(ji,jj) - spgu(ji,jj) 
     
    385381      ! 
    386382   END SUBROUTINE updateu2d 
     383 
    387384 
    388385   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) 
     
    403400         DO jj=j1,j2 
    404401            DO ji=i1,i2 
    405                tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj)  
     402               tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
    406403            END DO 
    407404         END DO 
     
    410407         DO jj=j1,j2 
    411408            DO ji=i1,i2 
    412                tabres(ji,jj) =  tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj)   
     409               tabres(ji,jj) =  tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj)   
    413410               !     
    414411               ! Update "now" 3d velocities: 
    415412               spgv(ji,jj) = 0.e0 
    416413               DO jk=1,jpkm1 
    417                   spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    418                END DO 
    419                spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj) 
     414                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     415               END DO 
     416               spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 
    420417               ! 
    421418               zcorr = tabres(ji,jj) - spgv(ji,jj) 
     
    436433               spgv(ji,jj) = 0.e0 
    437434               DO jk=1,jpkm1 
    438                   spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    439                END DO 
    440                spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj) 
     435                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
     436               END DO 
     437               spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 
    441438               ! 
    442439               zcorr = vb_b(ji,jj) - spgv(ji,jj) 
     
    489486   END SUBROUTINE updateSSH 
    490487 
     488 
    491489   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 
    492490      !!--------------------------------------------- 
     
    519517   END SUBROUTINE updateub2b 
    520518 
     519 
    521520   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    522521      !!--------------------------------------------- 
     
    555554      !!           *** ROUTINE updateT *** 
    556555      !!--------------------------------------------- 
    557 #  include "domzgr_substitute.h90" 
    558  
    559556      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    560557      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    561558      LOGICAL, iNTENT(in) :: before 
    562  
     559      ! 
    563560      INTEGER :: ji,jj,jk 
    564561      REAL(wp) :: ztemp 
     562      !!--------------------------------------------- 
    565563 
    566564      IF (before) THEN 
     
    600598 
    601599# if defined key_zdftke 
     600 
    602601   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
    603602      !!--------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r5656 r5845  
    1717   PUBLIC Agrif_trc, interptrn 
    1818 
    19 #  include "domzgr_substitute.h90"   
    2019#  include "vectopt_loop_substitute.h90" 
    2120  !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r5836 r5845  
    1919   PUBLIC Agrif_Sponge_trc, interptrn_sponge 
    2020 
    21    !! * Substitutions 
    22 #  include "domzgr_substitute.h90" 
    2321   !!---------------------------------------------------------------------- 
    2422   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     
    7472               DO jj = j1,j2-1 
    7573                  DO ji = i1,i2-1 
    76                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    77                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     74                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     75                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    7876                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    7977                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     
    8583 
    8684                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN  
    87                         zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk) 
     85                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 
    8886                        ! horizontal diffusive trends 
    8987                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r5656 r5845  
    6464      !!           *** ROUTINE updateT *** 
    6565      !!--------------------------------------------- 
    66 #  include "domzgr_substitute.h90" 
    6766      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    6867      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5836 r5845  
    3434 
    3535   !! * Substitutions 
    36 #  include "domzgr_substitute.h90" 
    3736#  include "vectopt_loop_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
     
    7675      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
    7776      ! 
     77!!gm BUG if scale factor reduction !!!! 
    7878      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
    7979      e1e2u (:,:) = e1u(:,:) * e2u(:,:)   ;   r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 
     
    8484      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    8585      ! 
    86       hu(:,:) = 0._wp                        ! Ocean depth at U- and V-points 
    87       hv(:,:) = 0._wp 
    88       DO jk = 1, jpk 
    89          hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    90          hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     86      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)     ! Ocean depth at U- and V-points 
     87      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 
     88      DO jk = 2, jpk 
     89         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
     90         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
    9191      END DO 
    9292      !                                        ! Inverse of the local depth 
    93       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
    94       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
     93      r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
     94      r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
    9595      ! 
    9696      CALL dom_stp      ! Time step 
     
    554554            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 
    555555 
    556             CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors 
    557             CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
    558             CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
    559             CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
     556            CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) ! scale factors 
     557            CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 
     558            CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 
     559            CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 
    560560 
    561561            CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth 
     
    571571            ! 
    572572            IF( nmsh <= 6 ) THEN                                        ! 3D vertical scale factors 
    573                CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) 
    574                CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
    575                CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
    576                CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
     573               CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) 
     574               CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 
     575               CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 
     576               CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 
    577577            ELSE                                                        ! 2D bottom scale factors 
    578578               CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) 
     
    580580               !                                                        ! deduces the 3D scale factors 
    581581               DO jk = 1, jpk 
    582                   fse3t_n(:,:,jk) = e3t_1d(jk)                                    ! set to the ref. factors 
    583                   fse3u_n(:,:,jk) = e3t_1d(jk) 
    584                   fse3v_n(:,:,jk) = e3t_1d(jk) 
    585                   fse3w_n(:,:,jk) = e3w_1d(jk) 
     582                  e3t_n(:,:,jk) = e3t_1d(jk)                                    ! set to the ref. factors 
     583                  e3u_n(:,:,jk) = e3t_1d(jk) 
     584                  e3v_n(:,:,jk) = e3t_1d(jk) 
     585                  e3w_n(:,:,jk) = e3w_1d(jk) 
    586586               END DO 
    587587               DO jj = 1,jpj                                                  ! adjust the deepest values 
    588588                  DO ji = 1,jpi 
    589589                     ik = mbkt(ji,jj) 
    590                      fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 
    591                      fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 
     590                     e3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 
     591                     e3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 
    592592                  END DO 
    593593               END DO 
     
    595595                  DO jj = 1, jpjm1 
    596596                     DO ji = 1, jpim1 
    597                         fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) ) 
    598                         fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) ) 
     597                        e3u_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji+1,jj,jk) ) 
     598                        e3v_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji,jj+1,jk) ) 
    599599                     END DO 
    600600                  END DO 
    601601               END DO 
    602                CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp )   ;   CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp )   ! lateral boundary conditions 
    603                CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp )   ;   CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp ) 
     602               CALL lbc_lnk( e3u_n(:,:,:) , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_n(:,:,:), 'U', 1._wp )   ! lateral boundary conditions 
     603               CALL lbc_lnk( e3v_n(:,:,:) , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_n(:,:,:), 'V', 1._wp ) 
    604604               ! 
    605605               DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    606                   WHERE( fse3u_n(:,:,jk) == 0._wp )   fse3u_n(:,:,jk) = e3t_1d(jk) 
    607                   WHERE( fse3v_n(:,:,jk) == 0._wp )   fse3v_n(:,:,jk) = e3t_1d(jk) 
     606                  WHERE( e3u_n(:,:,jk) == 0._wp )   e3u_n(:,:,jk) = e3t_1d(jk) 
     607                  WHERE( e3v_n(:,:,jk) == 0._wp )   e3v_n(:,:,jk) = e3t_1d(jk) 
    608608               END DO 
    609609            END IF 
    610610 
    611611            IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level 
    612                CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) ) 
    613                CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) ) 
     612               CALL iom_get( inum4, jpdom_data, 'gdept_0', gdept_n(:,:,:) ) 
     613               CALL iom_get( inum4, jpdom_data, 'gdepw_0', gdepw_n(:,:,:) ) 
    614614            ELSE                                                           ! 2D bottom depth 
    615615               CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) 
     
    617617               ! 
    618618               DO jk = 1, jpk                                              ! deduces the 3D depth 
    619                   fsdept_n(:,:,jk) = gdept_1d(jk) 
    620                   fsdepw_n(:,:,jk) = gdepw_1d(jk) 
     619                  gdept_n(:,:,jk) = gdept_1d(jk) 
     620                  gdepw_n(:,:,jk) = gdepw_1d(jk) 
    621621               END DO 
    622622               DO jj = 1, jpj 
     
    624624                     ik = mbkt(ji,jj) 
    625625                     IF( ik > 0 ) THEN 
    626                         fsdepw_n(ji,jj,ik+1) = zprw(ji,jj) 
    627                         fsdept_n(ji,jj,ik  ) = zprt(ji,jj) 
    628                         fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik) 
     626                        gdepw_n(ji,jj,ik+1) = zprw(ji,jj) 
     627                        gdept_n(ji,jj,ik  ) = zprt(ji,jj) 
     628                        gdept_n(ji,jj,ik+1) = gdept_n(ji,jj,ik) + e3t_n(ji,jj,ik) 
    629629                     ENDIF 
    630630                  END DO 
     
    640640            CALL iom_get( inum4, jpdom_unknown, 'e3w_1d'  , e3w_1d   ) 
    641641            DO jk = 1, jpk 
    642                fse3t_n(:,:,jk) = e3t_1d(jk)                              ! set to the ref. factors 
    643                fse3u_n(:,:,jk) = e3t_1d(jk) 
    644                fse3v_n(:,:,jk) = e3t_1d(jk) 
    645                fse3w_n(:,:,jk) = e3w_1d(jk) 
    646                fsdept_n(:,:,jk) = gdept_1d(jk) 
    647                fsdepw_n(:,:,jk) = gdepw_1d(jk) 
     642               e3t_n(:,:,jk) = e3t_1d(jk)                              ! set to the ref. factors 
     643               e3u_n(:,:,jk) = e3t_1d(jk) 
     644               e3v_n(:,:,jk) = e3t_1d(jk) 
     645               e3w_n(:,:,jk) = e3w_1d(jk) 
     646               gdept_n(:,:,jk) = gdept_1d(jk) 
     647               gdepw_n(:,:,jk) = gdepw_1d(jk) 
    648648            END DO 
    649649         ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r5836 r5845  
    8585 
    8686   !! * Substitutions 
    87 #  include "domzgr_substitute.h90" 
    8887#  include "vectopt_loop_substitute.h90" 
    8988   !!---------------------------------------------------------------------- 
     
    421420   END SUBROUTINE dta_dyn_init 
    422421 
     422 
    423423   SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 
    424424      !!---------------------------------------------------------------------- 
     
    449449         DO jj = 2, jpjm1 
    450450            DO ji = fs_2, fs_jpim1   ! vector opt. 
    451                zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) 
    452                zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) 
    453                zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) 
    454                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    455                zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    456                zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
     451               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * e3u_n(ji  ,jj  ,jk) 
     452               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * e3u_n(ji-1,jj  ,jk) 
     453               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * e3v_n(ji  ,jj  ,jk) 
     454               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * e3v_n(ji  ,jj-1,jk) 
     455               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)  
    457456            END DO 
    458457         END DO 
    459458      END DO 
    460459      !                              !  update the horizontal divergence with the runoff inflow 
    461       IF( ln_dynrnf )  zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / fse3t(:,:,1) 
     460      IF( ln_dynrnf )  zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 
    462461      ! 
    463462      CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
     
    465464      pw(:,:,jpk) = 0._wp 
    466465      DO jk = jpkm1, 1, -1 
    467          pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 
     466         pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk) 
    468467      END DO 
    469468      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r5836 r5845  
    8787 
    8888   !! * Substitutions 
    89 #  include "domzgr_substitute.h90" 
    9089#  include "vectopt_loop_substitute.h90" 
    9190   !!---------------------------------------------------------------------- 
    92    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     91   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    9392   !! $Id$ 
    9493   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    430429         DO jt = 1, nn_divdmp 
    431430            ! 
    432             DO jk = 1, jpkm1 
     431            DO jk = 1, jpkm1           ! hdiv = e1e1 * div 
    433432               hdiv(:,:) = 0._wp 
    434433               DO jj = 2, jpjm1 
    435434                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    436                      hdiv(ji,jj) =   & 
    437                         (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * u_bkginc(ji  ,jj  ,jk)     & 
    438                          - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * u_bkginc(ji-1,jj  ,jk)     & 
    439                          + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & 
    440                          - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  & 
    441                          / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     435                     hdiv(ji,jj) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)    & 
     436                        &           - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)    & 
     437                        &           + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)    & 
     438                        &           - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  ) / e3t_n(ji,jj,jk) 
    442439                  END DO 
    443440               END DO 
     
    446443               DO jj = 2, jpjm1 
    447444                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    448                      u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
    449                         &                                               - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
    450                         &                                             * r1_e1u(ji,jj) * umask(ji,jj,jk)  
    451                      v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
    452                         &                                               - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
    453                         &                                             * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
     445                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk)                         & 
     446                        &               + 0.2_wp * ( hdiv(ji+1,jj) - hdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     447                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         & 
     448                        &               + 0.2_wp * ( hdiv(ji,jj+1) - hdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
    454449                  END DO 
    455450               END DO 
     
    645640      ! used to prevent the applied increments taking the temperature below the local freezing point  
    646641      DO jk = 1, jpkm1 
    647         CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) ) 
     642        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) ) 
    648643      END DO 
    649644         ! 
     
    877872            IF( lk_vvl ) THEN 
    878873               DO jk = 1, jpk 
    879                   fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     874                  e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    880875               END DO 
    881876            ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r5132 r5845  
    5959#endif 
    6060 
    61 #  include "domzgr_substitute.h90" 
    6261   !!---------------------------------------------------------------------- 
    6362   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    289288                              DO ik = 1, jpkm1 
    290289                                 dta%u2d(ib) = dta%u2d(ib) & 
    291                        &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
     290                       &                          + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    292291                              END DO 
    293                               dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
     292                              dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    294293                           END DO 
    295294                           igrd = 3                      ! meridional velocity 
     
    300299                              DO ik = 1, jpkm1 
    301300                                 dta%v2d(ib) = dta%v2d(ib) & 
    302                        &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
     301                       &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    303302                              END DO 
    304                               dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
     303                              dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    305304                           END DO 
    306305                        ENDIF                     
     
    353352                        DO ik = 1, jpkm1 
    354353                           dta%u2d(ib) = dta%u2d(ib) & 
    355                  &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
     354                 &                       + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    356355                        END DO 
    357                         dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
     356                        dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    358357                        DO ik = 1, jpkm1 
    359358                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
     
    367366                        DO ik = 1, jpkm1 
    368367                           dta%v2d(ib) = dta%v2d(ib) & 
    369                  &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
     368                 &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    370369                        END DO 
    371                         dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
     370                        dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    372371                        DO ik = 1, jpkm1 
    373372                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
     
    882881         ENDIF 
    883882#endif 
    884  
    885       ENDDO ! ib_bdy  
    886  
     883         ! 
     884      END DO ! ib_bdy  
     885      ! 
    887886      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init') 
    888  
    889       END SUBROUTINE bdy_dta_init 
     887      ! 
     888   END SUBROUTINE bdy_dta_init 
    890889 
    891890#else 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4689 r5845  
    3838                        ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 
    3939 
    40 #  include "domzgr_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
    4241   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    5352      !! 
    5453      !!---------------------------------------------------------------------- 
    55       !! 
    5654      INTEGER, INTENT( in )           :: kt               ! Main time step counter 
    5755      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
    58       !! 
    59       INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
    60       LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    61       !! 
     56      ! 
     57      INTEGER :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
     58      LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    6259      REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities 
    63  
    64       IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') 
    65  
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn') 
     63      ! 
    6664      ll_dyn2d = .true. 
    6765      ll_dyn3d = .true. 
    68  
     66      ! 
    6967      IF( PRESENT(dyn3d_only) ) THEN 
    70          IF( dyn3d_only ) ll_dyn2d = .false. 
     68         IF( dyn3d_only )   ll_dyn2d = .false. 
    7169      ENDIF 
    7270 
     
    7472      DO ib_bdy = 1, nb_bdy 
    7573         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
    76      &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 
    77       ENDDO 
     74     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true. 
     75      END DO 
    7876 
    7977      !------------------------------------------------------- 
     
    8179      !------------------------------------------------------- 
    8280 
    83       CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
     81      CALL wrk_alloc( jpi,jpj,   pua2d, pva2d )  
    8482 
    8583      !------------------------------------------------------- 
     
    8785      !------------------------------------------------------- 
    8886 
    89       ! "After" velocities:  
     87      !                          ! "After" velocities:  
     88      pua2d(:,:) = 0._wp 
     89      pva2d(:,:) = 0._wp      
     90      DO jk = 1, jpkm1 
     91         pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     92         pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     93      END DO 
     94      pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:) 
     95      pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:) 
    9096 
    91       pua2d(:,:) = 0.e0 
    92       pva2d(:,:) = 0.e0       
    93       DO jk = 1, jpkm1 
    94          pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    95          pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     97      DO jk = 1 , jpkm1 
     98         ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk) 
     99         va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk) 
    96100      END DO 
    97101 
    98       pua2d(:,:) = pua2d(:,:) * hur_a(:,:) 
    99       pva2d(:,:) = pva2d(:,:) * hvr_a(:,:) 
    100102 
    101       DO jk = 1 , jpkm1 
    102          ua(:,:,jk) = (ua(:,:,jk) - pua2d(:,:)) * umask(:,:,jk) 
    103          va(:,:,jk) = (va(:,:,jk) - pva2d(:,:)) * vmask(:,:,jk) 
    104       END DO 
    105  
    106       ! "Before" velocities (required for Orlanski condition):  
    107  
    108       IF ( ll_orlanski ) THEN           
     103      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only)  
    109104         DO jk = 1 , jpkm1 
    110             ub(:,:,jk) = (ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk) 
    111             vb(:,:,jk) = (vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk) 
     105            ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk) 
     106            vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk) 
    112107         END DO 
    113       END IF 
     108      ENDIF 
    114109 
    115110      !------------------------------------------------------- 
     
    118113      !------------------------------------------------------- 
    119114 
    120       IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, hur_a(:,:), hvr_a(:,:), ssha ) 
     115      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha ) 
    121116 
    122       IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 
     117      IF( ll_dyn3d )   CALL bdy_dyn3d( kt ) 
    123118 
    124119      !------------------------------------------------------- 
    125120      ! Recombine velocities 
    126121      !------------------------------------------------------- 
    127  
     122      ! 
    128123      DO jk = 1 , jpkm1 
    129124         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
    130125         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
    131126      END DO 
    132  
     127      ! 
    133128      IF ( ll_orlanski ) THEN 
    134129         DO jk = 1 , jpkm1 
     
    137132         END DO 
    138133      END IF 
    139  
    140       CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
    141  
     134      ! 
     135      CALL wrk_dealloc( jpi,jpj,  pua2d, pva2d )  
     136      ! 
    142137      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 
    143  
     138      ! 
    144139   END SUBROUTINE bdy_dyn 
    145140 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r5215 r5845  
    2929   PUBLIC   bdy_dyn3d_dmp ! routine called by step 
    3030 
    31    !! * Substitutions 
    32 #  include "domzgr_substitute.h90" 
    3331   !!---------------------------------------------------------------------- 
    3432   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    4644      !!---------------------------------------------------------------------- 
    4745      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    48       !! 
     46      ! 
    4947      INTEGER               :: ib_bdy ! loop index 
    50       !! 
    51  
     48      !!---------------------------------------------------------------------- 
     49      ! 
    5250      DO ib_bdy=1, nb_bdy 
    53  
     51         ! 
    5452         SELECT CASE( cn_dyn3d(ib_bdy) ) 
    55          CASE('none') 
    56             CYCLE 
    57          CASE('frs') 
    58             CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    59          CASE('specified') 
    60             CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    61          CASE('zero') 
    62             CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    63          CASE('orlanski') 
    64             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
    65          CASE('orlanski_npo') 
    66             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    67          CASE DEFAULT 
    68             CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
     53         CASE('none')        ;   CYCLE 
     54         CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     55         CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     56         CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     57         CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     58         CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
     59         CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    6960         END SELECT 
    70       ENDDO 
    71  
     61      END DO 
     62      ! 
    7263   END SUBROUTINE bdy_dyn3d 
     64 
    7365 
    7466   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) 
     
    8072      !! 
    8173      !!---------------------------------------------------------------------- 
    82       INTEGER                    ::   kt 
    83       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    84       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    85       INTEGER,        INTENT(in) ::   ib_bdy  ! BDY set index 
    86       !! 
     74      INTEGER        , INTENT(in) ::   kt 
     75      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     76      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
     77      INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index 
     78      ! 
    8779      INTEGER  ::   jb, jk         ! dummy loop indices 
    8880      INTEGER  ::   ii, ij, igrd   ! local integers 
     
    112104      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    113105      ! 
    114       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    115  
     106      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     107      ! 
    116108      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe') 
    117  
     109      ! 
    118110   END SUBROUTINE bdy_dyn3d_spe 
    119111 
     112 
    120113   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 
    121114      !!---------------------------------------------------------------------- 
     
    125118      !! 
    126119      !!---------------------------------------------------------------------- 
    127       INTEGER                    ::   kt 
     120      INTEGER        , INTENT(in) ::   kt 
    128121      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    129       TYPE(OBC_DATA), INTENT(in) ::   dta  ! OBC external data 
     122      TYPE(OBC_DATA) , INTENT(in) ::   dta  ! OBC external data 
    130123      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    131124      !! 
     
    157150      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    158151      ! 
    159       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    160  
    161       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') 
    162  
     152      IF( kt == nit000 ) CLOSE( unit = 102 ) 
     153      ! 
     154      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_zro') 
     155      ! 
    163156   END SUBROUTINE bdy_dyn3d_zro 
     157 
    164158 
    165159   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) 
     
    174168      !!               topography. Tellus, 365-382. 
    175169      !!---------------------------------------------------------------------- 
    176       INTEGER                    ::   kt 
     170      INTEGER        , INTENT(in) ::   kt 
    177171      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    178       TYPE(OBC_DATA), INTENT(in) ::   dta  ! OBC external data 
     172      TYPE(OBC_DATA) , INTENT(in) ::   dta  ! OBC external data 
    179173      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    180       !! 
     174      ! 
    181175      INTEGER  ::   jb, jk         ! dummy loop indices 
    182176      INTEGER  ::   ii, ij, igrd   ! local integers 
     
    208202      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    209203      ! 
    210       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    211  
     204      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     205      ! 
    212206      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 
    213  
     207      ! 
    214208   END SUBROUTINE bdy_dyn3d_frs 
     209 
    215210 
    216211   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     
    259254      !! 
    260255      !!---------------------------------------------------------------------- 
    261       INTEGER                    ::   kt 
    262       !! 
     256      INTEGER, INTENT(in) ::   kt 
     257      ! 
    263258      INTEGER  ::   jb, jk         ! dummy loop indices 
    264259      INTEGER  ::   ii, ij, igrd   ! local integers 
    265260      REAL(wp) ::   zwgt           ! boundary weight 
    266       INTEGER  ::  ib_bdy          ! loop index 
     261      INTEGER  ::   ib_bdy         ! loop index 
    267262      !!---------------------------------------------------------------------- 
    268263      ! 
    269264      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 
    270265      ! 
    271       !------------------------------------------------------- 
    272  
    273266      DO ib_bdy=1, nb_bdy 
    274267         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN 
     
    300293      ! 
    301294      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 
    302  
     295      ! 
    303296   END SUBROUTINE bdy_dyn3d_dmp 
    304297 
     
    311304      WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 
    312305   END SUBROUTINE bdy_dyn3d 
    313  
    314306   SUBROUTINE bdy_dyn3d_dmp( kt )      ! Empty routine 
    315307      WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 
    316308   END SUBROUTINE bdy_dyn3d_dmp 
    317  
    318309#endif 
    319310 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r5836 r5845  
    13191319               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    13201320               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    1321                bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
     1321               bdysurftot = bdysurftot + hu_n   (nbi  , nbj)                           & 
    13221322                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
    13231323                  &                    * tmask_i(nbi  , nbj)                           & 
     
    13321332               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    13331333               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    1334                bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
     1334               bdysurftot = bdysurftot + hv_n   (nbi, nbj  )                           & 
    13351335                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
    13361336                  &                    * tmask_i(nbi, nbj  )                           & 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r5132 r5845  
    288288   END SUBROUTINE bdytide_init 
    289289 
     290 
    290291   SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset ) 
    291292      !!---------------------------------------------------------------------- 
     
    295296      !!                 
    296297      !!---------------------------------------------------------------------- 
    297       INTEGER, INTENT( in )            ::   kt          ! Main timestep counter 
    298       TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices 
    299       TYPE(OBC_DATA),  INTENT(inout)   ::   dta         ! OBC external data 
    300       TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data 
    301       INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option) 
    302       INTEGER,INTENT( in ), OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if jit 
    303                                                         ! is present then units = subcycle timesteps. 
    304                                                         ! time_offset = 0  => get data at "now"    time level 
    305                                                         ! time_offset = -1 => get data at "before" time level 
    306                                                         ! time_offset = +1 => get data at "after"  time level 
    307                                                         ! etc. 
    308       !! 
    309       INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
     298      INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter 
     299      TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices 
     300      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data 
     301      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data 
     302      INTEGER, OPTIONAL, INTENT(in   ) ::   jit         ! Barotropic timestep counter (for timesplitting option) 
     303      INTEGER, OPTIONAL, INTENT(in   ) ::   time_offset ! time offset in units of timesteps. NB. if jit 
     304      !                                                 ! is present then units = subcycle timesteps. 
     305      !                                                 ! time_offset = 0  => get data at "now"    time level 
     306      !                                                 ! time_offset = -1 => get data at "before" time level 
     307      !                                                 ! time_offset = +1 => get data at "after"  time level 
     308      !                                                 ! etc. 
     309      ! 
    310310      INTEGER                          :: itide, igrd, ib   ! dummy loop indices 
    311311      INTEGER                          :: time_add          ! time offset in units of timesteps 
     312      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
    312313      REAL(wp)                         :: z_arg, z_sarg, zflag, zramp       
    313314      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 
     
    380381   END SUBROUTINE bdytide_update 
    381382 
     383 
    382384   SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 
    383385      !!---------------------------------------------------------------------- 
     
    387389      !!                 
    388390      !!---------------------------------------------------------------------- 
    389       INTEGER, INTENT( in )            ::   kt          ! Main timestep counter 
    390       INTEGER, INTENT( in ),OPTIONAL   ::   kit         ! Barotropic timestep counter (for timesplitting option) 
    391       INTEGER, INTENT( in ),OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if kit 
    392                                                         ! is present then units = subcycle timesteps. 
    393                                                         ! time_offset = 0  => get data at "now"    time level 
    394                                                         ! time_offset = -1 => get data at "before" time level 
    395                                                         ! time_offset = +1 => get data at "after"  time level 
    396                                                         ! etc. 
    397       !! 
    398       LOGICAL  :: lk_first_btstp  ! =.TRUE. if time splitting and first barotropic step 
    399       INTEGER,          DIMENSION(jpbgrd) :: ilen0  
     391      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter 
     392      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
     393      INTEGER, OPTIONAL, INTENT(in) ::   time_offset ! time offset in units of timesteps. NB. if kit 
     394      !                                              ! is present then units = subcycle timesteps. 
     395      !                                              ! time_offset = 0  => get data at "now"    time level 
     396      !                                              ! time_offset = -1 => get data at "before" time level 
     397      !                                              ! time_offset = +1 => get data at "after"  time level 
     398      !                                              ! etc. 
     399      ! 
     400      LOGICAL  :: lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
     401      INTEGER  :: itide, ib_bdy, ib, igrd   ! loop indices 
     402      INTEGER  :: time_add                  ! time offset in units of timesteps 
     403      INTEGER, DIMENSION(jpbgrd) :: ilen0  
    400404      INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts 
    401       INTEGER  :: itide, ib_bdy, ib, igrd                     ! loop indices 
    402       INTEGER  :: time_add                                    ! time offset in units of timesteps 
    403405      REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
    404406      !!---------------------------------------------------------------------- 
     
    511513   END SUBROUTINE bdy_dta_tides 
    512514 
     515 
    513516   SUBROUTINE tide_init_elevation( idx, td ) 
    514517      !!---------------------------------------------------------------------- 
    515518      !!                 ***  ROUTINE tide_init_elevation  *** 
    516519      !!---------------------------------------------------------------------- 
    517       TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices 
    518       TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data 
    519       !! * Local declarations 
    520       INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays) 
     520      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices 
     521      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
     522      ! 
     523      INTEGER ::   itide, igrd, ib       ! dummy loop indices 
     524      INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays) 
    521525      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    522       INTEGER                            ::   itide, igrd, ib      ! dummy loop indices 
     526      !!---------------------------------------------------------------------- 
    523527 
    524528      igrd=1    
     
    544548      END DO 
    545549 
    546       DEALLOCATE(mod_tide,phi_tide) 
    547  
     550      DEALLOCATE( mod_tide, phi_tide ) 
     551      ! 
    548552   END SUBROUTINE tide_init_elevation 
    549553 
     554 
    550555   SUBROUTINE tide_init_velocities( idx, td ) 
    551556      !!---------------------------------------------------------------------- 
    552557      !!                 ***  ROUTINE tide_init_elevation  *** 
    553558      !!---------------------------------------------------------------------- 
    554       TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices 
    555       TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data 
    556       !! * Local declarations 
    557       INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
     559      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices 
     560      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
     561      ! 
     562      INTEGER ::   itide, igrd, ib       ! dummy loop indices 
     563      INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays) 
    558564      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    559       INTEGER                            ::   itide, igrd, ib      ! dummy loop indices 
     565      !!---------------------------------------------------------------------- 
    560566 
    561567      ilen0(2) =  SIZE(td%u0(:,1,1)) 
     
    564570      igrd=2                                 ! U grid. 
    565571 
    566       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
     572      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    567573 
    568574      DO itide = 1, nb_harmo 
     
    581587      END DO 
    582588 
    583       DEALLOCATE(mod_tide,phi_tide) 
     589      DEALLOCATE( mod_tide , phi_tide ) 
    584590 
    585591      igrd=3                                 ! V grid. 
    586592 
    587       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
     593      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    588594 
    589595      DO itide = 1, nb_harmo 
     
    601607         ENDDO 
    602608      END DO 
    603  
     609      ! 
    604610      DEALLOCATE(mod_tide,phi_tide) 
    605  
     611      ! 
    606612  END SUBROUTINE tide_init_velocities 
     613 
    607614#else 
    608615   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5836 r5845  
    3232   PUBLIC bdy_vol        ! routine called by dynspg_flt.h90 
    3333 
    34    !! * Substitutions 
    35 #  include "domzgr_substitute.h90" 
    3634   !!---------------------------------------------------------------------- 
    3735   !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
     
    111109               ii = idx%nbi(jb,jgrd) 
    112110               ij = idx%nbj(jb,jgrd) 
    113                zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     111               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 
    114112            END DO 
    115113         END DO 
     
    119117               ii = idx%nbi(jb,jgrd) 
    120118               ij = idx%nbj(jb,jgrd) 
    121                zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     119               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk)  
    122120            END DO 
    123121         END DO 
     
    144142               ij = idx%nbj(jb,jgrd) 
    145143               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 
    146                ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     144               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 
    147145            END DO 
    148146         END DO 
     
    153151               ij = idx%nbj(jb,jgrd) 
    154152               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 
    155                ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     153               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 
    156154            END DO 
    157155         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    r5215 r5845  
    3131   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data) 
    3232 
    33    !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3533   !!---------------------------------------------------------------------- 
    3634   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    174172            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point 
    175173               DO jk = 1, jpk 
    176                   zl = fsdept(ji,jj,jk) 
     174                  zl = gdept_n(ji,jj,jk) 
    177175                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data 
    178176                     zup(jk) =  puvd(ji,jj,1    ,1) 
     
    222220      ENDIF 
    223221      ! 
    224       IF( lwp .AND. kt == nit000 ) THEN   ! control print 
    225          WRITE(numout,*) ' U current ' 
    226          WRITE(numout,*) 
    227          WRITE(numout,*)'  level = 1' 
    228          CALL prihre( puvd(:,:,1    ,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    229          WRITE(numout,*)'  level = ', jpk/2 
    230          CALL prihre( puvd(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    231          WRITE(numout,*)'  level = ', jpkm1 
    232          CALL prihre( puvd(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    233          WRITE(numout,*) 
    234          WRITE(numout,*) ' V current ' 
    235          WRITE(numout,*) 
    236          WRITE(numout,*)'  level = 1' 
    237          CALL prihre( puvd(:,:,1    ,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    238          WRITE(numout,*)'  level = ', jpk/2 
    239          CALL prihre( puvd(:,:,jpk/2,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    240          WRITE(numout,*)'  level = ', jpkm1 
    241          CALL prihre( puvd(:,:,jpkm1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    242          WRITE(numout,*) 
    243       ENDIF 
    244       ! 
    245222      IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==!  
    246223         !                                !==   (data used only for initialization)  ==! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r5215 r5845  
    4343 
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
     
    204203            DO jj = 2, jpjm1 
    205204               DO ji = fs_2, fs_jpim1   ! vector opt. 
    206                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     205                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    207206                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) ) 
    208207                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r5836 r5845  
    2828 
    2929   !! * Substitutions 
    30 #  include "domzgr_substitute.h90" 
    3130#  include "zdfddm_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r5215 r5845  
    1111   USE in_out_manager 
    1212 
    13  
    1413   IMPLICIT NONE 
    1514   PUBLIC 
    1615 
    17     
    1816   PUBLIC crs_dom_alloc  ! Called from crsini.F90 
    1917   PUBLIC crs_dom_alloc2  ! Called from crsini.F90 
     
    161159      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                        
    162160 
    163       ! Direction of lateral diffusion 
    164  
    165  
     161   !!---------------------------------------------------------------------- 
     162   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    166163   !! $Id$ 
     164   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     165   !!---------------------------------------------------------------------- 
    167166CONTAINS 
    168167    
     
    258257 
    259258   END FUNCTION crs_dom_alloc 
    260     
     259 
     260 
    261261   INTEGER FUNCTION crs_dom_alloc2() 
    262262      !!------------------------------------------------------------------- 
     
    272272      crs_dom_alloc2 = MAXVAL(ierr) 
    273273 
    274       END FUNCTION crs_dom_alloc2 
     274   END FUNCTION crs_dom_alloc2 
     275 
    275276 
    276277   SUBROUTINE dom_grid_glo 
     
    312313   END SUBROUTINE dom_grid_glo 
    313314 
     315 
    314316   SUBROUTINE dom_grid_crs 
    315317      !!-------------------------------------------------------------------- 
     
    318320      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain 
    319321      !!--------------------------------------------------------------------- 
    320  
    321322      ! 
    322323      !                        Switch to coarse grid domain 
     
    349350      nlejt(:)  = nlejt_crs(:) 
    350351      njmppt(:) = njmppt_crs(:) 
    351  
    352  
    353352      ! 
    354353   END SUBROUTINE dom_grid_crs 
    355354    
    356        
    357355   !!====================================================================== 
    358356 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5302 r5845  
    3030   !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe) 
    3131   !!=================================================================== 
    32  
    3332   USE dom_oce        ! ocean space and time domain and to get jperio 
    34    USE wrk_nemo       ! work arrays 
    3533   USE crs            ! domain for coarse grid 
     34   ! 
    3635   USE in_out_manager  
    3736   USE par_kind 
    3837   USE crslbclnk 
     38   USE wrk_nemo       ! work arrays 
    3939   USE lib_mpp 
    40     
    4140 
    4241   IMPLICIT NONE 
     
    5453   REAL(wp) :: r_inf = 1e+36 
    5554 
    56    !! Substitutions 
    57 #  include "domzgr_substitute.h90" 
    58     
     55   !!---------------------------------------------------------------------- 
     56   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5957   !! $Id$ 
     58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     59   !!---------------------------------------------------------------------- 
    6060CONTAINS 
    61  
    6261 
    6362   SUBROUTINE crs_dom_msk 
     
    133132   END SUBROUTINE crs_dom_msk 
    134133 
     134 
    135135   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs ) 
    136136      !!---------------------------------------------------------------- 
     
    334334      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V) 
    335335      !!              cd_op       = applied operation (SUM, VOL, WGT) 
    336       !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v) 
     336      !!              p_e3      = (Optional) parent grid vertical level thickness (e3u or e3v) 
    337337      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid 
    338338      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid 
     
    348348      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1) 
    349349      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2) 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
     350      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
    351351 
    352352      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity  
     
    469469      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    470470      !!                                       for velocities (U or V) 
    471       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     471      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    472472      !!              p_pfield    = U or V on the parent grid 
    473473      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
     
    478478      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    479479      !!---------------------------------------------------------------- 
    480       !!  
    481       !!  Arguments 
    482480      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    483481      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     
    485483      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    486484      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    487       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
     485      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
    488486      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    489487      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska 
    490488      REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
    491  
    492  
    493       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    494  
    495       !! Local variables 
     489      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs ! Coarse grid box 3D quantity  
     490      ! 
    496491      INTEGER  :: ji, jj, jk  
    497492      INTEGER  :: ii, ij, ijie, ijje, je_2 
     
    499494      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
    500495      !!----------------------------------------------------------------   
    501     
    502       p_fld_crs(:,:,:) = 0.0 
    503  
     496      ! 
     497      p_fld_crs(:,:,:) = 0._wp 
     498      ! 
    504499      SELECT CASE ( cd_op ) 
    505500       
     
    11361131      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors;  
    11371132      !!                                       for velocities (U or V) 
    1138       !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v) 
     1133      !!              p_e3      = parent grid vertical level thickness (e3u or e3v) 
    11391134      !!              p_pfield    = U or V on the parent grid 
    11401135      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging 
     
    11521147      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    11531148      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    1154       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
     1149      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
    11551150      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    11561151      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r5215 r5845  
    3333   PUBLIC crs_dom_wri        ! routine called by crsini.F90 
    3434 
     35   !!---------------------------------------------------------------------- 
     36   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3537   !! $Id$ 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    3640CONTAINS 
    3741 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5836 r5845  
    3333 
    3434   !! * Substitutions 
    35 #  include "zdfddm_substitute.h90" 
    36 #  include "domzgr_substitute.h90" 
    3735#  include "vectopt_loop_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
     
    6159      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
    6260      ! 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfse3t, zfse3u, zfse3v, zfse3w   ! 3D workspace for e3 
     61      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
    6462      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs 
    6563      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs   
     
    6967 
    7068      !  Initialize arrays 
    71       CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3w ) 
    72       CALL wrk_alloc( jpi,jpj,jpk,   zfse3u, zfse3v ) 
    73       CALL wrk_alloc( jpi,jpj,jpk,   zt    , zs     ) 
    74       ! 
    75       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     69      CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w ) 
     70      CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v ) 
     71      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   ) 
     72      ! 
     73      CALL wrk_alloc( jpi_crs,jpj_crs,jpk,  zt_crs, zs_crs ) 
    7674 
    7775      ! Depth work arrrays 
    78       zfse3t(:,:,:) = fse3t(:,:,:) 
    79       zfse3u(:,:,:) = fse3u(:,:,:) 
    80       zfse3v(:,:,:) = fse3v(:,:,:) 
    81       zfse3w(:,:,:) = fse3w(:,:,:) 
     76      ze3t(:,:,:) = e3t_n(:,:,:) 
     77      ze3u(:,:,:) = e3u_n(:,:,:) 
     78      ze3v(:,:,:) = e3v_n(:,:,:) 
     79      ze3w(:,:,:) = e3w_n(:,:,:) 
    8280 
    8381      IF( kt == nit000  ) THEN 
     
    107105      !  Temperature 
    108106      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
    109       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     107      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    110108      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    111109 
     
    116114      !  Salinity 
    117115      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    118       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     116      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    119117      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    120118 
     
    123121 
    124122      !  U-velocity 
    125       CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     123      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    126124      ! 
    127125      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    134132         END DO 
    135133      END DO 
    136       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    137       CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     134      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     135      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    138136 
    139137      CALL iom_put( "uoce"  , un_crs )   ! i-current  
     
    142140 
    143141      !  V-velocity 
    144       CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     142      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    145143      !                                                                                  
    146144      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
     
    153151         END DO 
    154152      END DO 
    155       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    156       CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     153      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     154      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    157155  
    158156      CALL iom_put( "voce"  , vn_crs )   ! i-current  
     
    162160      
    163161      !  Kinetic energy 
    164       CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     162      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
    165163      CALL iom_put( "eken", rke_crs ) 
    166164 
     
    188186      IF( ln_crs_wn ) THEN 
    189187         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
    190        !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w ) 
     188       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 
    191189      ELSE 
    192190        wn_crs(:,:,jpk) = 0._wp 
     
    199197 
    200198      !  avt, avs 
     199!!gm BUG   TOP always uses avs !!! 
    201200      SELECT CASE ( nn_crs_kz ) 
    202201         CASE ( 0 ) 
    203             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     202            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    204203         CASE ( 1 ) 
    205             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     204            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    206205         CASE ( 2 ) 
    207             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    208207      END SELECT 
    209208      ! 
     
    211210       
    212211      !  sbc fields   
    213       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
     212      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )   
    214213      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
    215214      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
     
    233232 
    234233      !  free memory 
    235       CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    236       CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    237       CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       ) 
    238       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     234      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w ) 
     235      CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v ) 
     236      CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   ) 
     237      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,  zt_crs, zs_crs ) 
    239238      ! 
    240239      CALL iom_swap( "nemo" )     ! return back on high-resolution grid 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5836 r5845  
    3030   PUBLIC   crs_init   ! called by nemogcm.F90 module 
    3131 
    32    !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
    34    !!---------------------------------------------------------------------- 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3534   !! $Id$ 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    3737CONTAINS 
     
    6464      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output. 
    6565      !! As is, crsfun takes into account vvl.    
    66       !!      Talked about pre-setting the surface array to avoid IF/ENDIFS and division. 
     66      !!      Talked about pre-setting the surface array to avoid IF/ENDIF and division. 
    6767      !!      But have then to make that preset array here and elsewhere. 
    6868      !!      that is called every timestep... 
     
    7373      INTEGER  :: ierr                                ! allocation error status 
    7474      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    75       REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w 
     75      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w 
    7676 
    7777      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn 
     
    187187      
    188188     ! 
    189      CALL wrk_alloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
    190      ! 
    191      zfse3t(:,:,:) = fse3t(:,:,:) 
    192      zfse3u(:,:,:) = fse3u(:,:,:) 
    193      zfse3v(:,:,:) = fse3v(:,:,:) 
    194      zfse3w(:,:,:) = fse3w(:,:,:) 
     189     CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w ) 
     190     ! 
     191     ze3t(:,:,:) = e3t_n(:,:,:) 
     192     ze3u(:,:,:) = e3u_n(:,:,:) 
     193     ze3v(:,:,:) = e3v_n(:,:,:) 
     194     ze3w(:,:,:) = e3w_n(:,:,:) 
    195195 
    196196     !    3.d.2   Surfaces  
    197      CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    ) 
    198      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 
    199      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 
     197     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  ) 
     198     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u ) 
     199     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v ) 
    200200    
    201201     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) 
     
    204204     !    3.d.3   Vertical scale factors 
    205205     ! 
    206      CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
    207      CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
    208      CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
    209      CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
     206     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
     207     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
     208     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
     209     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
    210210 
    211211     ! Replace 0 by e3t_0 or e3w_0 
     
    222222 
    223223     !    3.d.3   Vertical depth (meters) 
    224      CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 )  
    225      CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 ) 
     224     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 )  
     225     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 ) 
    226226 
    227227 
     
    230230     !--------------------------------------------------------- 
    231231     ! 4.a. Ocean volume or area unmasked and masked 
    232      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t ) 
     232     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t ) 
    233233     ! 
    234234     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:) 
     
    237237     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:) 
    238238 
    239      CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w ) 
     239     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w ) 
    240240     ! 
    241241     !--------------------------------------------------------- 
     
    252252      ! 7. Finish and clean-up 
    253253      !--------------------------------------------------------- 
    254       CALL wrk_dealloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
     254      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w ) 
    255255      ! 
    256256   END SUBROUTINE crs_init 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r5215 r5845  
    77   !!===================================================================== 
    88   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code 
    9  
     9   !!---------------------------------------------------------------------- 
    1010   USE dom_oce 
    1111   USE crs 
     
    1313   USE par_kind, ONLY: wp 
    1414   USE in_out_manager 
    15  
    16     
    1715    
    1816   INTERFACE crs_lbc_lnk 
     
    2220   PUBLIC crs_lbc_lnk 
    2321    
     22   !!---------------------------------------------------------------------- 
     23   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    2424   !! $Id$ 
     25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     26   !!---------------------------------------------------------------------- 
    2527CONTAINS 
    2628 
     
    3537      !!                Upon exiting, switch back to full domain indices. 
    3638      !!---------------------------------------------------------------------- 
    37       !! Arguments 
    3839      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type 
    3940      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
     
    4243      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    4344      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    44        
    45       !! local vairables 
     45      ! 
    4646      LOGICAL                                                   ::   ll_grid_crs 
    4747      REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    48  
    4948      !!---------------------------------------------------------------------- 
    5049       
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r5836 r5845  
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
    4141       
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    4543   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    9997      ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    10098      ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    101       CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     99      CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    102100      ! 
    103101      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    104102      DO jk = 1, jpkm1 
    105          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
     103         zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    106104      END DO 
    107105      IF( .NOT.lk_vvl ) THEN 
     
    123121       
    124122      !                                         ! steric sea surface height 
    125       CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )                 ! now in situ and potential density 
     123      CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
    126124      zrhop(:,:,jpk) = 0._wp 
    127125      CALL iom_put( 'rhop', zrhop ) 
     
    129127      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    130128      DO jk = 1, jpkm1 
    131          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
     129         zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    132130      END DO 
    133131      IF( .NOT.lk_vvl ) THEN 
     
    159157         DO jj = 1, jpj 
    160158            DO ji = 1, jpi 
    161                zztmp = area(ji,jj) * fse3t(ji,jj,jk) 
     159               zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 
    162160               ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
    163161               zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r5505 r5845  
    3030  !!    
    3131  !!---------------------------------------------------------------------- 
    32   !! * Modules used 
    3332  USE oce             ! ocean dynamics and tracers 
    3433  USE dom_oce         ! ocean space and time domain 
     
    5150  PRIVATE 
    5251 
    53   !! * Routine accessibility 
    5452  PUBLIC   dia_dct      ! routine called by step.F90 
    5553  PUBLIC   dia_dct_init ! routine called by opa.F90 
     
    6058  PRIVATE  dia_dct_wri 
    6159 
    62 #include "domzgr_substitute.h90" 
    63  
    64   !! * Shared module variables 
    6560  LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag 
    6661 
    67   !! * Module variables 
    6862  INTEGER :: nn_dct        ! Frequency of computation 
    6963  INTEGER :: nn_dctwri     ! Frequency of output 
     
    112106  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d   
    113107 
     108   !!---------------------------------------------------------------------- 
     109   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    114110   !! $Id$ 
     111   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     112   !!---------------------------------------------------------------------- 
    115113CONTAINS 
    116  
    117114  
    118115  INTEGER FUNCTION diadct_alloc()  
     
    130127  
    131128  END FUNCTION diadct_alloc  
     129 
    132130 
    133131  SUBROUTINE dia_dct_init 
     
    208206     !!               Reinitialise all relevant arrays to zero  
    209207     !!--------------------------------------------------------------------- 
    210      !! * Arguments 
    211      INTEGER,INTENT(IN)        ::kt 
    212  
    213      !! * Local variables 
     208     INTEGER,INTENT(in)        ::kt 
     209     ! 
    214210     INTEGER             :: jsec,            &! loop on sections 
    215211                            itotal            ! nb_sec_max*nb_type_class*nb_class_max 
     
    220216     REAL(wp), POINTER, DIMENSION(:)    :: zwork !   "   
    221217     REAL(wp), POINTER, DIMENSION(:,:,:):: zsum  !   " 
    222  
    223218     !!---------------------------------------------------------------------     
     219     ! 
    224220     IF( nn_timing == 1 )   CALL timing_start('dia_dct') 
    225221 
     
    619615                            zumid_ice, zvmid_ice,                &!U/V ice velocity  
    620616                            zTnorm                                !transport of velocity through one cell's sides  
    621      REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep !temperature/salinity/potential density/ssh/depth at u/v point 
     617     REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point 
    622618 
    623619     TYPE(POINT_SECTION) :: k 
     
    723719              END SELECT  
    724720  
    725               zfsdep= fsdept(k%I,k%J,jk)  
     721              zdep= gdept_n(k%I,k%J,jk)  
    726722   
    727723              !compute velocity with the correct direction  
     
    737733              !zTnorm=transport through one cell;  
    738734              !velocity* cell's length * cell's thickness  
    739               zTnorm=zumid*e2u(k%I,k%J)*  fse3u(k%I,k%J,jk)+     &  
    740                      zvmid*e1v(k%I,k%J)*  fse3v(k%I,k%J,jk)  
     735              zTnorm=zumid*e2u(k%I,k%J)*  e3u_n(k%I,k%J,jk)+     &  
     736                     zvmid*e1v(k%I,k%J)*  e3v_n(k%I,k%J,jk)  
    741737 
    742738#if ! defined key_vvl 
     
    828824     !!  
    829825     !!-------------------------------------------------------------  
    830      !! * arguments  
    831826     TYPE(SECTION),INTENT(INOUT) :: sec  
    832827     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section  
     
    834829     TYPE(POINT_SECTION) :: k  
    835830     INTEGER  :: jk,jseg,jclass                        ! dummy variables for looping on level/segment/classes   
    836      REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point  
     831     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point  
    837832     !!-------------------------------------------------------------  
    838833  
     
    903898              END SELECT  
    904899  
    905               zfsdep= fsdept(k%I,k%J,jk)  
     900              zdep= gdept_n(k%I,k%J,jk)  
    906901   
    907902              !-------------------------------  
     
    932927                    ( sec%ztem(jclass) .EQ.99.)) .AND.                     &  
    933928  
    934                     ((( zfsdep .GE. sec%zlay(jclass)) .AND.                &  
    935                     (   zfsdep .LE. sec%zlay(jclass+1))) .OR.              &  
     929                    ((( zdep .GE. sec%zlay(jclass)) .AND.                &  
     930                    (   zdep .LE. sec%zlay(jclass+1))) .OR.              &  
    936931                    ( sec%zlay(jclass) .EQ. 99. ))                         &  
    937932                                                                   ))   THEN  
     
    11441139 
    11451140     CALL wrk_dealloc(nb_type_class , zsumclasses )   
     1141     ! 
    11461142  END SUBROUTINE dia_dct_wri 
     1143 
    11471144 
    11481145  FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     
    12141211  !*local declations 
    12151212  INTEGER :: ii1, ij1, ii2, ij2                                ! local integer 
    1216   REAL(wp):: ze3t, zfse3, zwgt1, zwgt2, zbis, zdepu            ! local real 
     1213  REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu            ! local real 
    12171214  REAL(wp):: zet1, zet2                                        ! weight for interpolation  
    12181215  REAL(wp):: zdep1,zdep2                                       ! differences of depth 
     
    12411238  IF( ln_sco )THEN   ! s-coordinate case 
    12421239 
    1243      zdepu = ( fsdept(ii1,ij1,kk) +  fsdept(ii2,ij2,kk) ) /2  
    1244      zdep1 = fsdept(ii1,ij1,kk) - zdepu 
    1245      zdep2 = fsdept(ii2,ij2,kk) - zdepu 
     1240     zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp  
     1241     zdep1 = gdept_n(ii1,ij1,kk) - zdepu 
     1242     zdep2 = gdept_n(ii2,ij2,kk) - zdepu 
    12461243 
    12471244     ! weights 
     
    12551252  ELSE       ! full step or partial step case  
    12561253 
    1257 #if defined key_vvl 
    1258  
    1259      ze3t  = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk)  
    1260      zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk) 
    1261      zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk) 
    1262  
    1263 #else 
    1264  
    1265      ze3t  = fse3t(ii2,ij2,kk)   - fse3t(ii1,ij1,kk)  
    1266      zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk) 
    1267      zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk) 
    1268  
    1269 #endif 
     1254     ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)  
     1255     zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 
     1256     zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 
    12701257 
    12711258     IF(kk .NE. 1)THEN 
     
    12881275 
    12891276  ENDIF 
    1290  
    1291  
    1292   END FUNCTION interp 
     1277      ! 
     1278   END FUNCTION interp 
    12931279 
    12941280#else 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r4292 r5845  
    2424   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp) 
    2525 
    26    !! * Substitutions 
    27 #  include "domzgr_substitute.h90" 
    2826   !!---------------------------------------------------------------------- 
    2927   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5836 r5845  
    3333 
    3434   !! * Substitutions 
    35 #  include "domzgr_substitute.h90" 
    3635#  include "vectopt_loop_substitute.h90" 
    3736   !!---------------------------------------------------------------------- 
     
    4039   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4140   !!---------------------------------------------------------------------- 
    42  
    4341CONTAINS 
    4442 
     
    8078            DO jj = 2, jpjm1 
    8179               DO ji = fs_2, fs_jpim1   ! vector opt. 
    82                   zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     80                  zwei  = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    8381                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    8482               END DO 
     
    106104            DO jj = 2, jpjm1 
    107105               DO ji = fs_2, fs_jpim1   ! vector opt. 
    108                   zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     106                  zwei  = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    109107                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    110108                  zvol  = zvol  + zwei 
     
    186184                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    187185                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    188                   zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
     186                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
    189187 
    190188                  IF( un(ji,jj,jk) > 0.e0 ) THEN  
     
    238236                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    239237                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    240                   zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
     238                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
    241239                   
    242240                  IF( un(ji,jj,jk) > 0.e0 ) THEN  
     
    290288                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    291289                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    292                   zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
     290                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
    293291                   
    294292                  IF( un(ji,jj,jk) > 0.e0 ) THEN  
     
    342340                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    343341                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    344                   zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
     342                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 
    345343                   
    346344                  IF( un(ji,jj,jk) > 0.e0 ) THEN  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5643 r5845  
    5151 
    5252   !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5453#  include "vectopt_loop_substitute.h90" 
    5554   !!---------------------------------------------------------------------- 
     
    165164         ! volume variation (calculated with scale factors) 
    166165         zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 
    167             &                           * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
     166            &                           * ( e3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
    168167         ! heat content variation 
    169168         zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk) &  
    170             &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 
     169            &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 
    171170         ! salt content variation 
    172171         zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)   & 
    173             &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 
     172            &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 
    174173      ENDDO 
    175174 
     
    191190      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors) 
    192191      DO jk = 1, jpkm1 
    193          zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 
     192         zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 
    194193      END DO 
    195194 
     
    275274          ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    276275          DO jk = 1, jpk 
    277              e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
    278              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
    279              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
     276             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                        ! initial vertical scale factors 
     277             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk)   ! initial heat content 
     278             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk)   ! initial salt content 
    280279          END DO 
    281280          frc_v = 0._wp                                           ! volume       trend due to forcing 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r5836 r5845  
    2020   USE dom_oce         ! ocean space and time domain 
    2121   USE phycst          ! physical constants 
     22   ! 
    2223   USE in_out_manager  ! I/O manager 
    2324   USE lib_mpp         ! MPP library 
     
    3132   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90 
    3233 
    33    LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag 
     34   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag 
     35    
    3436   ! note: following variables should move to local variables once iom_put is always used  
    3537   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m] 
     
    3840   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W] 
    3941 
    40    !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    187187            DO ji = 1, jpi 
    188188               ! 
    189                zzdep = fsdepw(ji,jj,jk) 
     189               zzdep = gdepw_n(ji,jj,jk) 
    190190               zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
    191191               zzdep = zzdep * tmask(ji,jj,1) 
     
    223223            DO ji = 1, jpi 
    224224               ! 
    225                zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1) 
     225               zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1) 
    226226               ! 
    227227               zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m) 
     
    270270         DO ji = 1, jpi 
    271271            ! 
    272             zzdep = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom 
     272            zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom 
    273273            ! 
    274274            iid = ik20(ji,jj) 
    275275            IF( iid /= 1 ) THEN  
    276                zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    277                   &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
     276               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation 
     277                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   & 
    278278                  &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   & 
    279279                  &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
     
    285285            iid = ik28(ji,jj) 
    286286            IF( iid /= 1 ) THEN  
    287                zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    288                   &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
     287               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation 
     288                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   & 
    289289                  &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   & 
    290290                  &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
     
    316316      ! integration down to ilevel 
    317317      DO jk = 1, ilevel 
    318          zthick(:,:) = zthick(:,:) + fse3t(:,:,jk) 
    319          htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 
     318         zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk) 
     319         htc3  (:,:) = htc3  (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 
    320320      END DO 
    321321      ! deepest layer 
     
    323323      DO jj = 1, jpj 
    324324         DO ji = 1, jpi 
    325             htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) )  & 
     325            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) )  & 
    326326                                                                   * tmask(ji,jj,ilevel+1) 
    327327         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r5147 r5845  
    5959   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d 
    6060 
    61  
    6261   !! * Substitutions 
    63 #  include "domzgr_substitute.h90" 
    6462#  include "vectopt_loop_substitute.h90" 
    6563   !!---------------------------------------------------------------------- 
     
    118116               DO jj = 1, jpj 
    119117                  DO ji = 1, jpi 
    120                      zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 
     118                     zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk) 
    121119                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    122120                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5836 r5845  
    3030   USE zdf_oce         ! ocean vertical physics 
    3131   USE ldftra          ! lateral physics: eddy diffusivity coef. 
     32   USE ldfdyn          ! lateral physics: eddy viscosity   coef. 
    3233   USE sol_oce         ! solver variables 
    3334   USE sbc_oce         ! Surface boundary condition: ocean fields 
     
    4142   USE zdfddm          ! vertical  physics: double diffusion 
    4243   USE diahth          ! thermocline diagnostics 
     44   ! 
    4345   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4446   USE in_out_manager  ! I/O manager 
     
    7678   !! * Substitutions 
    7779#  include "zdfddm_substitute.h90" 
    78 #  include "domzgr_substitute.h90" 
    7980#  include "vectopt_loop_substitute.h90" 
    8081   !!---------------------------------------------------------------------- 
     
    146147 
    147148      IF( .NOT.lk_vvl ) THEN 
    148          CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 
    149          CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 
    150          CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 
    151          CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
     149         CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
     150         CALL iom_put( "e3u" , e3u_n(:,:,:) ) 
     151         CALL iom_put( "e3v" , e3v_n(:,:,:) ) 
     152         CALL iom_put( "e3w" , e3w_n(:,:,:) ) 
    152153      ENDIF 
    153154 
     
    266267            DO jj = 1, jpj 
    267268               DO ji = 1, jpi 
    268                   z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     269                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    269270               END DO 
    270271            END DO 
     
    278279            DO jj = 1, jpj 
    279280               DO ji = 1, jpi 
    280                   z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     281                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    281282               END DO 
    282283            END DO 
     
    290291            DO jj = 2, jpjm1 
    291292               DO ji = fs_2, fs_jpim1   ! vector opt. 
    292                   zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    293                   zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    & 
    294                      &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  & 
     293                  zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     294                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    & 
     295                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  & 
    295296                     &          *  zztmp  
    296297                  ! 
    297                   zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    & 
    298                      &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  & 
     298                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    & 
     299                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  & 
    299300                     &          *  zztmp  
    300301                  ! 
     
    311312         z3d(:,:,jpk) = 0.e0 
    312313         DO jk = 1, jpkm1 
    313             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     314            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
    314315         END DO 
    315316         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     
    346347         z3d(:,:,jpk) = 0.e0 
    347348         DO jk = 1, jpkm1 
    348             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     349            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
    349350         END DO 
    350351         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     
    730731 
    731732      IF( lk_vvl ) THEN 
    732          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    733          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content 
    734          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * fse3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
    735          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * fse3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
     733         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
     734         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content 
     735         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
     736         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
    736737      ELSE 
    737738         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature 
     
    741742      ENDIF 
    742743      IF( lk_vvl ) THEN 
    743          zw3d(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    744          CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    745          CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
     744         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
     745         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
     746         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
    746747         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation 
    747748      ENDIF 
     
    913914      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    914915         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
     916         ! 
     917      CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
     918         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
     919      CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
     920         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
     921      CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
     922         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
     923      CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
     924         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
     925         ! 
    915926      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    916927         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    952963      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    953964      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
     965      ! 
     966      CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
     967      CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
     968      CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
     969      CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
     970      ! 
    954971      CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget 
    955972      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
     
    972989      !  
    973990   END SUBROUTINE dia_wri_state 
     991 
    974992   !!====================================================================== 
    975993END MODULE diawri 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5836 r5845  
    1111   !!                             to the optimization of BDY communications 
    1212   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio 
     13   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1314   !!---------------------------------------------------------------------- 
    1415 
     
    178179   LOGICAL, PUBLIC ::   ln_isfcav     !: presence of ISF  
    179180 
    180    !! All coordinates 
    181    !! --------------- 
    182    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m) 
    183    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m) 
    184    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f 
    185    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m) 
    186    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw 
    187    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m) 
     181!!gm 
    188182#if defined key_vvl 
    189183   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag 
    190  
    191    !! All coordinates 
    192    !! --------------- 
    193    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_n           !: now depth of T-points (sum of e3w) (m) 
    194    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_n, gdepw_n   !: now depth at T-W  points (m) 
    195    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_b, gdepw_b   !: before depth at T-W  points (m) 
    196    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_n              !: now    vertical scale factors at  t       point  (m) 
    197    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_n  , e3v_n     !:            -      -      -    -   u --v   points (m) 
    198    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_n  , e3f_n     !:            -      -      -    -   w --f   points (m) 
    199    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3uw_n , e3vw_n    !:            -      -      -    -   uw--vw  points (m) 
    200    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before     -      -      -    -   t       points (m) 
    201    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_b              !: before     -      -      -    -   t       points (m) 
    202    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -        -      -      -    -   u --v   points (m) 
    203    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3uw_b , e3vw_b    !:   -        -      -      -    -   uw--vw  points (m) 
    204    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_a              !: after      -      -      -    -   t       point  (m) 
    205    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_a  , e3v_a     !:   -        -      -      -    -   u --v   points (m) 
    206184#else 
    207    LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
     185   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: variable grid flag 
    208186#endif 
    209    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur  , hvr     !: Now    inverse of u and v-points ocean depth (1/m) 
    210    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu   , hv      !:        depth at u- and v-points (meters) 
    211    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht             !:        depth at t-points (meters) 
    212    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehur_a, ehvr_a !: After  inverse of u and v-points ocean depth (1/m) 
    213    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehu_a , ehv_a  !:        depth at u- and v-points (meters) 
    214    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehur_b, ehvr_b !: Before inverse of u and v-points ocean depth (1/m) 
    215    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehu_b , ehv_b  !:        depth at u- and v-points (meters) 
    216    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters) 
    217    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0    !: reference depth at u- and v-points (meters) 
     187!!gm 
     188 
     189   !                                                        !  ref.   ! before  !   now   ! after  ! 
     190   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
     191   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
     192   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
     195   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
     196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     197 
     198   !                                                        !  ref.   ! before  !   now   ! 
     199   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m] 
     200   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m] 
     201   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m] 
     202    
     203   !                                                      !  ref. ! before  !   now   !  after  ! 
     204   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n ,    ht_a   !: t-depth              [m] 
     205   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m] 
     206   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: u-depth              [m] 
     207   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m] 
     208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m] 
     209 
    218210 
    219211   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    220212   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
    221213 
    222    !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 
     214   !! 1D reference  vertical coordinate 
    223215   !! =-----------------====------ 
    224216   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m) 
     
    347339         &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    348340         ! 
    349       ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         & 
    350          &      gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         & 
    351          &      gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) ) 
    352          ! 
    353 #if defined key_vvl 
    354       ALLOCATE( gdep3w_n(jpi,jpj,jpk) , e3t_n (jpi,jpj,jpk) , e3u_n (jpi,jpj,jpk) ,                           & 
    355          &      gdept_n (jpi,jpj,jpk) , e3v_n (jpi,jpj,jpk) , e3w_n (jpi,jpj,jpk) ,                           & 
    356          &      gdepw_n (jpi,jpj,jpk) , e3f_n (jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , e3uw_n(jpi,jpj,jpk) ,     & 
    357          &      e3t_b   (jpi,jpj,jpk) , e3u_b (jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk) ,                           & 
    358          &      e3uw_b  (jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,                                                 & 
    359          &      gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) ,                           & 
    360          &      e3t_a   (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) ,                           & 
    361          &      ehu_a   (jpi,jpj)     , ehv_a (jpi,jpj),                                                     & 
    362          &      ehur_a  (jpi,jpj)     , ehvr_a(jpi,jpj),                                                     & 
    363          &      ehu_b   (jpi,jpj)     , ehv_b (jpi,jpj),                                                     & 
    364          &      ehur_b  (jpi,jpj)     , ehvr_b(jpi,jpj),                                  STAT=ierr(5) )                           
    365 #endif 
    366          ! 
    367       ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) ,     & 
    368          &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht  (jpi,jpj) , STAT=ierr(6)  ) 
     341      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     & 
     342         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             & 
     343         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 
     344         ! 
     345      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   & 
     346         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   &                         & 
     347         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   &                         & 
     348         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             & 
     349         !                                                          ! 
     350         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         & 
     351         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &                
     352         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                        
     353         ! 
     354      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           & 
     355         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     & 
     356         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     & 
     357         &      ht_a(jpi,jpj) , hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  ) 
     358         ! 
    369359         ! 
    370360      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
     
    400390   !!====================================================================== 
    401391END MODULE dom_oce 
    402  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5836 r5845  
    1313   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration 
    1414   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 
     15   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1516   !!---------------------------------------------------------------------- 
    1617    
     
    3637   ! 
    3738   USE in_out_manager  ! I/O manager 
     39   USE wrk_nemo        ! Memory Allocation 
    3840   USE lib_mpp         ! distributed memory computing library 
    3941   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
     
    4547   PUBLIC   dom_init   ! called by opa.F90 
    4648 
    47    !! * Substitutions 
    48 #  include "domzgr_substitute.h90" 
    4949   !!------------------------------------------------------------------------- 
    5050   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    7272      INTEGER ::   jk          ! dummy loop argument 
    7373      INTEGER ::   iconf = 0   ! local integers 
     74      REAL(wp), POINTER, DIMENSION(:,:)   ::  z1_hu_0, z1_hv_0 
    7475      !!---------------------------------------------------------------------- 
    7576      ! 
     
    8283      ENDIF 
    8384      ! 
    84                              CALL dom_nam      ! read namelist ( namrun, namdom ) 
    85                              CALL dom_clo      ! Closed seas and lake 
    86                              CALL dom_hgr      ! Horizontal mesh 
    87                              CALL dom_zgr      ! Vertical mesh and bathymetry 
    88                              CALL dom_msk      ! Masks 
    89       IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency 
    90       ! 
    91       ht_0(:,:) = 0._wp                        ! Reference ocean depth at T-points 
    92       hu_0(:,:) = 0._wp                        ! Reference ocean depth at U-points 
    93       hv_0(:,:) = 0._wp                        ! Reference ocean depth at V-points 
    94       DO jk = 1, jpk 
     85      !              !==  Reference coordinate system  ==! 
     86      ! 
     87                     CALL dom_nam               ! read namelist ( namrun, namdom ) 
     88                     CALL dom_clo               ! Closed seas and lake 
     89                     CALL dom_hgr               ! Horizontal mesh 
     90                     CALL dom_zgr               ! Vertical mesh and bathymetry 
     91                     CALL dom_msk               ! Masks 
     92      IF( ln_sco )   CALL dom_stiff             ! Maximum stiffness ratio/hydrostatic consistency 
     93      ! 
     94      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness 
     95      hu_0(:,:) = e3u_0(:,:,1) * tmask(:,:,1) 
     96      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 
     97      DO jk = 2, jpk 
    9598         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    9699         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
     
    98101      END DO 
    99102      ! 
    100       IF( lk_vvl         )   CALL dom_vvl_init ! Vertical variable mesh 
    101       ! 
    102       IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
    103       ! 
    104       ! 
    105       hu(:,:) = 0._wp                          ! Ocean depth at U-points 
    106       hv(:,:) = 0._wp                          ! Ocean depth at V-points 
    107       ht(:,:) = 0._wp                          ! Ocean depth at T-points 
    108       DO jk = 1, jpkm1 
    109          hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    110          hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
    111          ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    112       END DO 
    113       !                                        ! Inverse of the local depth 
    114       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    115       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
    116  
    117                              CALL dom_stp      ! time step 
    118       IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file 
    119       IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control 
     103      !              !==  time varying part of coordinate system  ==! 
     104      ! 
     105      IF( lk_vvl ) THEN                         ! time varying : initialize before/now/after variables 
     106         CALL dom_vvl_init  
     107         ! 
     108      ELSE                                      ! Fix in time : set to the reference one for all 
     109         !    before         !          now          !       after         ! 
     110         gdept_b = gdept_0   ;   gdept_n = gdept_0   !        ---          ! depth of grid-points 
     111         gdepw_b = gdepw_0   ;   gdepw_n = gdepw_0   !        ---          ! 
     112                                 gde3w_n = gde3w_0   !        ---          ! 
     113         !                                                                   
     114           e3t_b =   e3t_0   ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors 
     115           e3u_b =   e3u_0   ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    ! 
     116           e3v_b =   e3v_0   ;     e3v_n =   e3u_0   ;   e3v_a =  e3v_0    ! 
     117                             ;     e3f_n =   e3f_0   !        ---          ! 
     118           e3w_b =   e3w_0   ;     e3w_n =   e3w_0   !        ---          ! 
     119          e3uw_b =  e3uw_0   ;    e3uw_n =  e3uw_0   !        ---          ! 
     120          e3vw_b =  e3vw_0   ;    e3vw_n =  e3vw_0   !        ---          ! 
     121         ! 
     122         !                                            !  
     123         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 ) 
     124         ! 
     125         z1_hu_0(:,:) = 1._wp / ( hu_0(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)    ! _i mask due to ISF 
     126         z1_hv_0(:,:) = 1._wp / ( hv_0(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     127         ! 
     128         !        before       !         now         !       after         ! 
     129         ;                     ;     ht_n =    hu_0  ;    ht_a =    hu_0   ! water column thickness 
     130         ;     hu_b =    hu_0  ;     hu_n =    hu_0  ;    hu_a =    hu_0   !  
     131         ;     hv_b =    hv_0  ;     hv_n =    hv_0  ;    hv_a =    hv_0   ! 
     132         ;  r1_hu_b = z1_hu_0  ;  r1_hu_n = z1_hu_0  ; r1_hu_a = z1_hu_0   ! inverse of water column thickness 
     133         ;  r1_hv_b = z1_hv_0  ;  r1_hv_n = z1_hv_0  ; r1_hv_a = z1_hv_0   ! 
     134         ! 
     135         CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 ) 
     136      ENDIF 
     137      ! 
     138      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
     139      ! 
     140                             CALL dom_stp       ! time step 
     141      IF( nmsh /= 0      )   CALL dom_wri       ! Create a domain file 
     142      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    120143      ! 
    121144      IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
     
    412435         DO jj = 2, jpjm1 
    413436            DO jk = 1, jpkm1 
    414                zr1(1) = umask(ji-1,jj  ,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji-1,jj  ,jk  )  &  
    415                     &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1)) & 
    416                     &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji-1,jj  ,jk  )  & 
    417                     &                         -gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1) + rsmall) ) 
    418                zr1(2) = umask(ji  ,jj  ,jk) *abs( (gdepw_0(ji+1,jj  ,jk  )-gdepw_0(ji  ,jj  ,jk  )  & 
    419                     &                         +gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) & 
    420                     &                        /(gdepw_0(ji+1,jj  ,jk  )+gdepw_0(ji  ,jj  ,jk  )  & 
    421                     &                         -gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) ) 
    422                zr1(3) = vmask(ji  ,jj  ,jk) *abs( (gdepw_0(ji  ,jj+1,jk  )-gdepw_0(ji  ,jj  ,jk  )  & 
    423                     &                         +gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) & 
    424                     &                        /(gdepw_0(ji  ,jj+1,jk  )+gdepw_0(ji  ,jj  ,jk  )  & 
    425                     &                         -gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) ) 
    426                zr1(4) = vmask(ji  ,jj-1,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji  ,jj-1,jk  )  & 
    427                     &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1)) & 
    428                     &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji  ,jj-1,jk  )  & 
    429                     &                         -gdepw_0(ji,  jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1) + rsmall) ) 
    430                zrxmax = MAXVAL(zr1(1:4)) 
    431                rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax) 
     437               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               &  
     438                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )            & 
     439                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               & 
     440                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk) 
     441               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               & 
     442                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )            & 
     443                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               & 
     444                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk) 
     445               zr1(3) =ABS(  (  gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
     446                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )            & 
     447                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               & 
     448                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk) 
     449               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               & 
     450                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )            & 
     451                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               & 
     452                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk) 
     453               zrxmax = MAXVAL( zr1(1:4) ) 
     454               rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax ) 
    432455            END DO 
    433456         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r4667 r5845  
    118118         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   & 
    119119            &                                           ' jpjzoom = ', jpjzoom 
    120          WRITE(numout,*) 
    121          WRITE(numout,*) '          conversion local  ==> data i-index domain' 
    122          WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    123          WRITE(numout,*) 
    124          WRITE(numout,*) '          conversion data   ==> local  i-index domain' 
    125          WRITE(numout,*) '             starting index' 
    126          WRITE(numout,25)              (mi0(ji),ji = 1,jpidta) 
    127          WRITE(numout,*) '             ending index' 
    128          WRITE(numout,25)              (mi1(ji),ji = 1,jpidta) 
    129          WRITE(numout,*) 
    130          WRITE(numout,*) '          conversion local  ==> data j-index domain' 
    131          WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    132          WRITE(numout,*) 
    133          WRITE(numout,*) '          conversion data  ==> local j-index domain' 
    134          WRITE(numout,*) '             starting index' 
    135          WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta) 
    136          WRITE(numout,*) '             ending index' 
    137          WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta) 
     120         IF( nn_print >= 1 ) THEN 
     121            WRITE(numout,*) 
     122            WRITE(numout,*) '          conversion local  ==> data i-index domain' 
     123            WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
     124            WRITE(numout,*) 
     125            WRITE(numout,*) '          conversion data   ==> local  i-index domain' 
     126            WRITE(numout,*) '             starting index' 
     127            WRITE(numout,25)              (mi0(ji),ji = 1,jpidta) 
     128            WRITE(numout,*) '             ending index' 
     129            WRITE(numout,25)              (mi1(ji),ji = 1,jpidta) 
     130            WRITE(numout,*) 
     131            WRITE(numout,*) '          conversion local  ==> data j-index domain' 
     132            WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
     133            WRITE(numout,*) 
     134            WRITE(numout,*) '          conversion data  ==> local j-index domain' 
     135            WRITE(numout,*) '             starting index' 
     136            WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta) 
     137            WRITE(numout,*) '             ending index' 
     138            WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta) 
     139         ENDIF 
    138140      ENDIF 
    139141 25   FORMAT( 100(10x,19i4,/) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5836 r5845  
    348348      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    349349 
    350       IF( lwp .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
     350      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    351351         WRITE(numout,*) 
    352352         WRITE(numout,*) '          longitude and e1 scale factors' 
     
    393393         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    394394            IF( .NOT. Agrif_Root() ) THEN 
    395               zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
     395              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2 )*Agrif_Parent(ppe2_m)   & 
     396               &              / (ra * rad)         ! CAUTIOn : split in 2 lignes for AGRIF 
    396397            ENDIF 
    397398         ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5836 r5845  
    400400      ! 
    401401      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    402  
     402      ! 
    403403      ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 
    404              
    405       IF( nprint == 1 .AND. lwp ) THEN      ! Control print 
    406          imsk(:,:) = INT( tmask_i(:,:) ) 
    407          WRITE(numout,*) ' tmask_i : ' 
    408          CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    409                &                           1, jpj, 1, 1, numout) 
    410          WRITE (numout,*) 
    411          WRITE (numout,*) ' dommsk: tmask for each level' 
    412          WRITE (numout,*) ' ----------------------------' 
    413          DO jk = 1, jpk 
    414             imsk(:,:) = INT( tmask(:,:,jk) ) 
    415  
    416             WRITE(numout,*) 
    417             WRITE(numout,*) ' level = ',jk 
    418             CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    419                &                              1, jpj, 1, 1, numout) 
    420          END DO 
    421          WRITE(numout,*) 
    422          WRITE(numout,*) ' dom_msk: vmask for each level' 
    423          WRITE(numout,*) ' -----------------------------' 
    424          DO jk = 1, jpk 
    425             imsk(:,:) = INT( vmask(:,:,jk) ) 
    426             WRITE(numout,*) 
    427             WRITE(numout,*) ' level = ',jk 
    428             CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    429                &                              1, jpj, 1, 1, numout) 
    430          END DO 
    431          WRITE(numout,*) 
    432          WRITE(numout,*) ' dom_msk: fmask for each level' 
    433          WRITE(numout,*) ' -----------------------------' 
    434          DO jk = 1, jpk 
    435             imsk(:,:) = INT( fmask(:,:,jk) ) 
    436             WRITE(numout,*) 
    437             WRITE(numout,*) ' level = ',jk 
    438             CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    439                &                              1, jpj, 1, 1, numout ) 
    440          END DO 
    441          WRITE(numout,*) 
    442          WRITE(numout,*) ' dom_msk: bmask ' 
    443          WRITE(numout,*) ' ---------------' 
    444          WRITE(numout,*) 
    445          imsk(:,:) = INT( bmask(:,:) ) 
    446          CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    447             &                              1, jpj, 1, 1, numout ) 
    448       ENDIF 
    449404      ! 
    450405      CALL wrk_dealloc( jpi, jpj, imsk ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90

    r4292 r5845  
    2222   PUBLIC   dom_stp   ! routine called by inidom.F90 
    2323 
    24    !! * Substitutions 
    25 #  include "domzgr_substitute.h90" 
    2624   !!---------------------------------------------------------------------- 
    2725   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5836 r5845  
    2020   !!---------------------------------------------------------------------- 
    2121   USE oce             ! ocean dynamics and tracers 
     22   USE phycst          ! physical constant 
    2223   USE dom_oce         ! ocean space and time domain 
    2324   USE sbc_oce         ! ocean surface boundary condition 
     25   USE restart         ! ocean restart 
     26   ! 
    2427   USE in_out_manager  ! I/O manager 
    2528   USE iom             ! I/O manager library 
    26    USE restart         ! ocean restart 
    2729   USE lib_mpp         ! distributed memory computing library 
    2830   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    6062 
    6163   !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6364#  include "vectopt_loop_substitute.h90" 
    6465   !!---------------------------------------------------------------------- 
     
    6768   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6869   !!---------------------------------------------------------------------- 
    69  
    7070CONTAINS 
    7171 
     
    8181         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    8282         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
    83          un_td = 0.0_wp 
    84          vn_td = 0.0_wp 
     83         un_td = 0._wp 
     84         vn_td = 0._wp 
    8585      ENDIF 
    8686      IF( ln_vvl_ztilde ) THEN 
     
    8989         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
    9090      ENDIF 
    91  
     91      ! 
    9292   END FUNCTION dom_vvl_alloc 
    9393 
     
    103103      !!               - interpolate scale factors 
    104104      !! 
    105       !! ** Action  : - fse3t_(n/b) and tilde_e3t_(n/b) 
    106       !!              - Regrid: fse3(u/v)_n 
    107       !!                        fse3(u/v)_b        
    108       !!                        fse3w_n            
    109       !!                        fse3(u/v)w_b       
    110       !!                        fse3(u/v)w_n       
    111       !!                        fsdept_n, fsdepw_n and fsde3w_n 
     105      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
     106      !!              - Regrid: e3(u/v)_n 
     107      !!                        e3(u/v)_b        
     108      !!                        e3w_n            
     109      !!                        e3(u/v)w_b       
     110      !!                        e3(u/v)w_n       
     111      !!                        gdept_n, gdepw_n and gde3w_n 
    112112      !!              - h(t/u/v)_0 
    113113      !!              - frq_rst_e3t and frq_rst_hdv 
     
    115115      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    116116      !!---------------------------------------------------------------------- 
    117       USE phycst,  ONLY : rpi, rsmall, rad 
    118       !! * Local declarations 
    119       INTEGER ::   ji,jj,jk 
     117      INTEGER ::   ji, jj, jk 
    120118      INTEGER ::   ii0, ii1, ij0, ij1 
    121119      REAL(wp)::   zcoef 
    122120      !!---------------------------------------------------------------------- 
     121      ! 
    123122      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_init') 
    124  
     123      ! 
    125124      IF(lwp) WRITE(numout,*) 
    126125      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 
    127126      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    128  
    129       ! choose vertical coordinate (z_star, z_tilde or layer) 
    130       ! ========================== 
    131       CALL dom_vvl_ctl 
    132  
    133       ! Allocate module arrays 
    134       ! ====================== 
     127      ! 
     128      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
     129      ! 
     130      !                    ! Allocate module arrays 
    135131      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 
    136  
    137       ! Read or initialize fse3t_(b/n), tilde_e3t_(b/n) and hdiv_lf (and e3t_a(jpk)) 
    138       ! ============================================================================ 
     132      ! 
     133      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    139134      CALL dom_vvl_rst( nit000, 'READ' ) 
    140       fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 
    141  
    142       ! Reconstruction of all vertical scale factors at now and before time steps 
    143       ! ============================================================================= 
    144       ! Horizontal scale factor interpolations 
    145       ! -------------------------------------- 
    146       CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
    147       CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
    148       CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
    149       CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
    150       CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 
    151       ! Vertical scale factor interpolations 
    152       ! ------------------------------------ 
    153       CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
    154       CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
    155       CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
    156       CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W'  ) 
    157       CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
    158       CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
    159       ! t- and w- points depth 
    160       ! ---------------------- 
    161       ! set the isf depth as it is in the initial step 
    162       fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
    163       fsdepw_n(:,:,1) = 0.0_wp 
    164       fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
    165       fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1) 
    166       fsdepw_b(:,:,1) = 0.0_wp 
    167  
    168       DO jk = 2, jpk 
     135      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
     136      ! 
     137      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
     138      !                                ! Horizontal interpolation of e3t 
     139      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U 
     140      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     141      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V  
     142      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     143      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F 
     144      !                                ! Vertical interpolation of e3t,u,v  
     145      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W 
     146      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  ) 
     147      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW 
     148      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     149      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW 
     150      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     151      ! 
     152      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
     153      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration) 
     154      gdepw_n(:,:,1) = 0.0_wp 
     155      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg 
     156      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1) 
     157      gdepw_b(:,:,1) = 0.0_wp 
     158      DO jk = 2, jpk                               ! vertical sum 
    169159         DO jj = 1,jpj 
    170160            DO ji = 1,jpi 
    171               !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    172                                                      ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    173                                                      ! 0.5 where jk = mikt   
    174                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    175                fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
    176                fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  & 
    177                    &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk))  
    178                fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj) 
    179                fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1) 
    180                fsdept_b(ji,jj,jk) =      zcoef  * ( fsdepw_b(ji,jj,jk  ) + 0.5 * fse3w_b(ji,jj,jk))  & 
    181                    &                + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) +       fse3w_b(ji,jj,jk))  
     161               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     162               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
     163               !                             ! 0.5 where jk = mikt      
     164!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ?? 
     165               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
     166               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     167               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     168                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk))  
     169               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 
     170               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1) 
     171               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  & 
     172                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk))  
    182173            END DO 
    183174         END DO 
    184175      END DO 
    185  
    186       ! Before depth and Inverse of the local depth of the water column at u- and v- points 
    187       ! ----------------------------------------------------------------------------------- 
    188       hu_b(:,:) = 0. 
    189       hv_b(:,:) = 0. 
    190       DO jk = 1, jpkm1 
    191          hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 
    192          hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
     176      ! 
     177      !                    !==  thickness of the water column  !!   (ocean portion only) 
     178      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
     179      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
     180      hv_b(:,:) = e3u_b(:,:,1) * vmask(:,:,1) 
     181      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) 
     182      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 
     183      DO jk = 2, jpkm1 
     184         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
     185         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
     186         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
     187         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
     188         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
    193189      END DO 
    194       hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) ) 
    195       hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) ) 
    196  
    197       ! Restoring frequencies for z_tilde coordinate 
    198       ! ============================================ 
     190      ! 
     191      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
     192      r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) )    ! _i mask due to ISF 
     193      r1_hu_n(:,:) = umask_i(:,:) / ( hu_n(:,:) + 1._wp - umask_i(:,:) ) 
     194      r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
     195      r1_hv_n(:,:) = vmask_i(:,:) / ( hv_n(:,:) + 1._wp - vmask_i(:,:) ) 
     196 
     197      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
    199198      IF( ln_vvl_ztilde ) THEN 
    200          ! Values in days provided via the namelist; use rsmall to avoid possible division by zero errors with faulty settings 
    201          frq_rst_e3t(:,:) = 2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
    202          frq_rst_hdv(:,:) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
    203          IF( ln_vvl_ztilde_as_zstar ) THEN 
    204             ! Ignore namelist settings and use these next two to emulate z-star using z-tilde 
    205             frq_rst_e3t(:,:) = 0.0_wp  
    206             frq_rst_hdv(:,:) = 1.0_wp / rdt 
    207          ENDIF 
    208          IF ( ln_vvl_zstar_at_eqtor ) THEN 
     199!!gm : idea: add here a READ in a file of custumized restoring frequency 
     200         !                                   ! Values in days provided via the namelist 
     201         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings 
     202         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
     203         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
     204         ! 
     205         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile 
     206            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings 
     207            frq_rst_hdv(:,:) = 1._wp / rdt 
     208         ENDIF 
     209         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    209210            DO jj = 1, jpj 
    210211               DO ji = 1, jpi 
     212!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default 
    211213                  IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    212214                     ! values outside the equatorial band and transition zone (ztilde) 
    213215                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
    214216                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
    215                   ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN 
     217                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
    216218                     ! values inside the equatorial band (ztilde as zstar) 
    217219                     frq_rst_e3t(ji,jj) =  0.0_wp 
    218220                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt 
    219                   ELSE 
    220                      ! values in the transition band (linearly vary from ztilde to ztilde as zstar values) 
     221                  ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
     222                     !                                      ! (linearly transition from z-tilde to z-star) 
    221223                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
    222224                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     
    229231               END DO 
    230232            END DO 
    231             IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN 
    232                ii0 = 103   ;   ii1 = 111        ! Suppress ztilde in the Foxe Basin for ORCA2 
     233            IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
     234               ii0 = 103   ;   ii1 = 111        
    233235               ij0 = 128   ;   ij1 = 135   ;    
    234236               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
     
    237239         ENDIF 
    238240      ENDIF 
    239  
     241      ! 
    240242      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init') 
    241  
     243      ! 
    242244   END SUBROUTINE dom_vvl_init 
    243245 
     
    261263      !!               - tilde_e3t_a: after increment of vertical scale factor  
    262264      !!                              in z_tilde case 
    263       !!               - fse3(t/u/v)_a 
     265      !!               - e3(t/u/v)_a 
    264266      !! 
    265267      !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling. 
     
    277279      LOGICAL                                :: ll_do_bclinic         ! temporary logical 
    278280      !!---------------------------------------------------------------------- 
     281      ! 
    279282      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_nxt') 
    280       CALL wrk_alloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
    281       CALL wrk_alloc( jpi, jpj, jpk, ze3t                     ) 
     283      ! 
     284      CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv ) 
     285      CALL wrk_alloc( jpi,jpj,jpk,   ze3t ) 
    282286 
    283287      IF(kt == nit000)   THEN 
     
    289293      ll_do_bclinic = .TRUE. 
    290294      IF( PRESENT(kcall) ) THEN 
    291          IF ( kcall == 2 .AND. ln_vvl_ztilde ) ll_do_bclinic = .FALSE. 
     295         IF( kcall == 2 .AND. ln_vvl_ztilde )  ll_do_bclinic = .FALSE. 
    292296      ENDIF 
    293297 
     
    295299      ! After acale factors at t-points ! 
    296300      ! ******************************* ! 
    297  
    298301      !                                                ! --------------------------------------------- ! 
    299                                                        ! z_star coordinate and barotropic z-tilde part ! 
     302      !                                                ! z_star coordinate and barotropic z-tilde part ! 
    300303      !                                                ! --------------------------------------------- ! 
    301  
     304      ! 
    302305      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    303306      DO jk = 1, jpkm1 
    304          ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0) 
    305          fse3t_a(:,:,jk) = fse3t_b(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     307         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 
     308         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    306309      END DO 
    307  
     310      ! 
    308311      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    309312         !                                                            ! ------baroclinic part------ ! 
     
    314317         ! 1 - barotropic divergence 
    315318         ! ------------------------- 
    316          zhdiv(:,:) = 0. 
    317          zht(:,:)   = 0. 
     319         zhdiv(:,:) = 0._wp 
     320         zht(:,:)   = 0._wp 
    318321         DO jk = 1, jpkm1 
    319             zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk) 
    320             zht  (:,:) = zht  (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     322            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
     323            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    321324         END DO 
    322325         zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 
     
    325328         ! -------------------------------------------------- 
    326329         IF( ln_vvl_ztilde ) THEN 
    327             IF( kt .GT. nit000 ) THEN 
     330            IF( kt > nit000 ) THEN 
    328331               DO jk = 1, jpkm1 
    329332                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
    330                      &          * ( hdiv_lf(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 
     333                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 
    331334               END DO 
    332335            ENDIF 
    333          END IF 
     336         ENDIF 
    334337 
    335338         ! II - after z_tilde increments of vertical scale factors 
    336339         ! ======================================================= 
    337          tilde_e3t_a(:,:,:) = 0.0_wp  ! tilde_e3t_a used to store tendency terms 
     340         tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms 
    338341 
    339342         ! 1 - High frequency divergence term 
     
    341344         IF( ln_vvl_ztilde ) THEN     ! z_tilde case 
    342345            DO jk = 1, jpkm1 
    343                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
     346               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
    344347            END DO 
    345348         ELSE                         ! layer case 
    346349            DO jk = 1, jpkm1 
    347                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
    348             END DO 
    349          END IF 
     350               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
     351            END DO 
     352         ENDIF 
    350353 
    351354         ! 2 - Restoring term (z-tilde case only) 
     
    355358               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 
    356359            END DO 
    357          END IF 
     360         ENDIF 
    358361 
    359362         ! 3 - Thickness diffusion term 
    360363         ! ---------------------------- 
    361          zwu(:,:) = 0.0_wp 
    362          zwv(:,:) = 0.0_wp 
    363          ! a - first derivative: diffusive fluxes 
    364          DO jk = 1, jpkm1 
     364         zwu(:,:) = 0._wp 
     365         zwv(:,:) = 0._wp 
     366         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
    365367            DO jj = 1, jpjm1 
    366368               DO ji = 1, fs_jpim1   ! vector opt. 
     
    374376            END DO 
    375377         END DO 
    376          ! b - correction for last oceanic u-v points 
    377          DO jj = 1, jpj 
     378         DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    378379            DO ji = 1, jpi 
    379380               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
     
    381382            END DO 
    382383         END DO 
    383          ! c - second derivative: divergence of diffusive fluxes 
    384          DO jk = 1, jpkm1 
     384         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    385385            DO jj = 2, jpjm1 
    386386               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    391391            END DO 
    392392         END DO 
    393          ! d - thickness diffusion transport: boundary conditions 
    394          !     (stored for tracer advction and continuity equation) 
     393         !                       ! d - thickness diffusion transport: boundary conditions 
     394         !                             (stored for tracer advction and continuity equation) 
    395395         CALL lbc_lnk( un_td , 'U' , -1._wp) 
    396396         CALL lbc_lnk( vn_td , 'V' , -1._wp) 
     
    410410         ! Maximum deformation control 
    411411         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    412          ze3t(:,:,jpk) = 0.0_wp 
     412         ze3t(:,:,jpk) = 0._wp 
    413413         DO jk = 1, jpkm1 
    414414            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     
    462462         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    463463         DO jk = 1, jpkm1 
    464             dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     464            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    465465         END DO 
    466466 
     
    470470      !                                           ! ---baroclinic part--------- ! 
    471471         DO jk = 1, jpkm1 
    472             fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     472            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    473473         END DO 
    474474      ENDIF 
     
    485485         zht(:,:) = 0.0_wp 
    486486         DO jk = 1, jpkm1 
    487             zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     487            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    488488         END DO 
    489489         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 
    490490         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    491          IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', z_tmax 
     491         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 
    492492         ! 
    493493         zht(:,:) = 0.0_wp 
    494494         DO jk = 1, jpkm1 
    495             zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk) 
     495            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 
    496496         END DO 
    497497         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 
    498498         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    499          IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', z_tmax 
     499         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 
    500500         ! 
    501501         zht(:,:) = 0.0_wp 
    502502         DO jk = 1, jpkm1 
    503             zht(:,:) = zht(:,:) + fse3t_b(:,:,jk) * tmask(:,:,jk) 
     503            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 
    504504         END DO 
    505505         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 
    506506         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    507          IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(fse3t_b))) =', z_tmax 
     507         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 
    508508         ! 
    509509         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) ) 
     
    524524      ! *********************************** ! 
    525525 
    526       CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3u_a(:,:,:), 'U' ) 
    527       CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3v_a(:,:,:), 'V' ) 
     526      CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' ) 
     527      CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' ) 
    528528 
    529529      ! *********************************** ! 
     
    531531      ! *********************************** ! 
    532532 
    533       hu_a(:,:) = 0._wp                        ! Ocean depth at U-points 
    534       hv_a(:,:) = 0._wp                        ! Ocean depth at V-points 
    535       DO jk = 1, jpkm1 
    536          hu_a(:,:) = hu_a(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 
    537          hv_a(:,:) = hv_a(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 
     533      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 
     534      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 
     535      DO jk = 2, jpkm1 
     536         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 
     537         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 
    538538      END DO 
    539539      !                                        ! Inverse of the local depth 
    540       hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    541       hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
    542  
    543       CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
    544       CALL wrk_dealloc( jpi, jpj, jpk, ze3t                     ) 
    545  
     540!!gm BUG ?  don't understand the use of umask_i here ..... 
     541      r1_hu_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
     542      r1_hv_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     543      ! 
     544      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
     545      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t ) 
     546      ! 
    546547      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt') 
    547  
     548      ! 
    548549   END SUBROUTINE dom_vvl_sf_nxt 
    549550 
     
    561562      !!               - recompute depths and water height fields 
    562563      !! 
    563       !! ** Action  :  - fse3t_(b/n), tilde_e3t_(b/n) and fse3(u/v)_n ready for next time step 
     564      !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step 
    564565      !!               - Recompute: 
    565       !!                    fse3(u/v)_b        
    566       !!                    fse3w_n            
    567       !!                    fse3(u/v)w_b       
    568       !!                    fse3(u/v)w_n       
    569       !!                    fsdept_n, fsdepw_n  and fsde3w_n 
     566      !!                    e3(u/v)_b        
     567      !!                    e3w_n            
     568      !!                    e3(u/v)w_b       
     569      !!                    e3(u/v)w_n       
     570      !!                    gdept_n, gdepw_n  and gde3w_n 
    570571      !!                    h(u/v) and h(u/v)r 
    571572      !! 
     
    573574      !!              Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    574575      !!---------------------------------------------------------------------- 
    575       !! * Arguments 
    576       INTEGER, INTENT( in )               :: kt       ! time step 
    577       !! * Local declarations 
    578       INTEGER                             :: ji,jj,jk       ! dummy loop indices 
    579       REAL(wp)                            :: zcoef 
     576      INTEGER, INTENT( in ) ::   kt   ! time step 
     577      ! 
     578      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     579      REAL(wp) ::   zcoef        ! local scalar 
    580580      !!---------------------------------------------------------------------- 
    581581 
     
    590590      ! Time filter and swap of scale factors 
    591591      ! ===================================== 
    592       ! - ML - fse3(t/u/v)_b are allready computed in dynnxt. 
     592      ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 
    593593      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    594594         IF( neuler == 0 .AND. kt == nit000 ) THEN 
     
    600600         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
    601601      ENDIF 
    602       fsdept_b(:,:,:) = fsdept_n(:,:,:) 
    603       fsdepw_b(:,:,:) = fsdepw_n(:,:,:) 
    604  
    605       fse3t_n(:,:,:) = fse3t_a(:,:,:) 
    606       fse3u_n(:,:,:) = fse3u_a(:,:,:) 
    607       fse3v_n(:,:,:) = fse3v_a(:,:,:) 
     602      gdept_b(:,:,:) = gdept_n(:,:,:) 
     603      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
     604 
     605      e3t_n(:,:,:) = e3t_a(:,:,:) 
     606      e3u_n(:,:,:) = e3u_a(:,:,:) 
     607      e3v_n(:,:,:) = e3v_a(:,:,:) 
    608608 
    609609      ! Compute all missing vertical scale factor and depths 
     
    611611      ! Horizontal scale factor interpolations 
    612612      ! -------------------------------------- 
    613       ! - ML - fse3u_b and fse3v_b are allready computed in dynnxt 
     613      ! - ML - e3u_b and e3v_b are allready computed in dynnxt 
    614614      ! - JC - hu_b, hv_b, hur_b, hvr_b also 
    615       CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n (:,:,:), 'F'  ) 
     615       
     616      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F'  ) 
     617       
    616618      ! Vertical scale factor interpolations 
    617619      ! ------------------------------------ 
    618       CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
    619       CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
    620       CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
    621       CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W'  ) 
    622       CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
    623       CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
     620      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
     621      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
     622      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     623      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  ) 
     624      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     625      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
    624626      ! t- and w- points depth 
    625627      ! ---------------------- 
    626628      ! set the isf depth as it is in the initial step 
    627       fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
    628       fsdepw_n(:,:,1) = 0.0_wp 
    629       fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
     629      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     630      gdepw_n(:,:,1) = 0.0_wp 
     631      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    630632 
    631633      DO jk = 2, jpk 
     
    635637                                                                 ! 1 for jk = mikt 
    636638               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    637                fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
    638                fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  & 
    639                    &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk))  
    640                fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj) 
     639               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     640               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     641                   &               + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk))  
     642               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 
    641643            END DO 
    642644         END DO 
    643645      END DO 
    644646 
    645       ! Local depth and Inverse of the local depth of the water column at u- and v- points 
    646647      ! ---------------------------------------------------------------------------------- 
    647       hu (:,:) = hu_a (:,:) 
    648       hv (:,:) = hv_a (:,:) 
    649  
    650       ! Inverse of the local depth 
    651       hur(:,:) = hur_a(:,:) 
    652       hvr(:,:) = hvr_a(:,:) 
    653  
    654       ! Local depth of the water column at t- points 
    655       ! -------------------------------------------- 
    656       ht(:,:) = 0. 
    657       DO jk = 1, jpkm1 
    658          ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     648      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:) 
     649      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:) 
     650      ! 
     651      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) 
     652      DO jk = 2, jpkm1 
     653         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    659654      END DO 
    660655 
    661656      ! Write outputs 
    662657      ! ============= 
    663       CALL iom_put(     "e3t" , fse3t_n  (:,:,:) ) 
    664       CALL iom_put(     "e3u" , fse3u_n  (:,:,:) ) 
    665       CALL iom_put(     "e3v" , fse3v_n  (:,:,:) ) 
    666       CALL iom_put(     "e3w" , fse3w_n  (:,:,:) ) 
    667       CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) ) 
     658      CALL iom_put(     "e3t" , e3t_n  (:,:,:) ) 
     659      CALL iom_put(     "e3u" , e3u_n  (:,:,:) ) 
     660      CALL iom_put(     "e3v" , e3v_n  (:,:,:) ) 
     661      CALL iom_put(     "e3w" , e3w_n  (:,:,:) ) 
     662      CALL iom_put( "tpt_dep" , gde3w_n(:,:,:) ) 
    668663      IF( iom_use("e3tdef") )   & 
    669          CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
     664         CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
    670665 
    671666      ! write restart file 
     
    674669      ! 
    675670      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_swp') 
    676  
     671      ! 
    677672   END SUBROUTINE dom_vvl_sf_swp 
    678673 
     
    801796            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
    802797            ! 
    803             id1 = iom_varid( numror, 'fse3t_b', ldstop = .FALSE. ) 
    804             id2 = iom_varid( numror, 'fse3t_n', ldstop = .FALSE. ) 
     798            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
     799            id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
    805800            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    806801            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
     
    810805            !                             ! --------- ! 
    811806            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    812                CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    813                CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 
     807               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
     808               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
    814809               ! needed to restart if land processor not computed  
    815                IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files' 
     810               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' 
    816811               WHERE ( tmask(:,:,:) == 0.0_wp )  
    817                   fse3t_n(:,:,:) = e3t_0(:,:,:) 
    818                   fse3t_b(:,:,:) = e3t_0(:,:,:) 
     812                  e3t_n(:,:,:) = e3t_0(:,:,:) 
     813                  e3t_b(:,:,:) = e3t_0(:,:,:) 
    819814               END WHERE 
    820815               IF( neuler == 0 ) THEN 
    821                   fse3t_b(:,:,:) = fse3t_n(:,:,:) 
     816                  e3t_b(:,:,:) = e3t_n(:,:,:) 
    822817               ENDIF 
    823818            ELSE IF( id1 > 0 ) THEN 
    824                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart files' 
    825                IF(lwp) write(numout,*) 'fse3t_n set equal to fse3t_b.' 
     819               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files' 
     820               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    826821               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    827                CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    828                fse3t_n(:,:,:) = fse3t_b(:,:,:) 
     822               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
     823               e3t_n(:,:,:) = e3t_b(:,:,:) 
    829824               neuler = 0 
    830825            ELSE IF( id2 > 0 ) THEN 
    831                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_b not found in restart files' 
    832                IF(lwp) write(numout,*) 'fse3t_b set equal to fse3t_n.' 
     826               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files' 
     827               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    833828               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    834                CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 
    835                fse3t_b(:,:,:) = fse3t_n(:,:,:) 
     829               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
     830               e3t_b(:,:,:) = e3t_n(:,:,:) 
    836831               neuler = 0 
    837832            ELSE 
    838                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart file' 
     833               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file' 
    839834               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    840835               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    841                DO jk=1,jpk 
    842                   fse3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 
    843                       &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 
    844                       &            + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 
     836               DO jk = 1, jpk 
     837                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 
     838                      &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)  & 
     839                      &          + e3t_0(:,:,jk)                              * (1._wp -tmask(:,:,jk)) 
    845840               END DO 
    846                fse3t_b(:,:,:) = fse3t_n(:,:,:) 
     841               e3t_b(:,:,:) = e3t_n(:,:,:) 
    847842               neuler = 0 
    848843            ENDIF 
     
    875870            ! 
    876871         ELSE                                   !* Initialize at "rest" 
    877             fse3t_b(:,:,:) = e3t_0(:,:,:) 
    878             fse3t_n(:,:,:) = e3t_0(:,:,:) 
     872            e3t_b(:,:,:) = e3t_0(:,:,:) 
     873            e3t_n(:,:,:) = e3t_0(:,:,:) 
    879874            sshn(:,:) = 0.0_wp 
    880875            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
     
    891886         !                                           ! all cases ! 
    892887         !                                           ! --------- ! 
    893          CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    894          CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) ) 
     888         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) ) 
     889         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) 
    895890         !                                           ! ----------------------- ! 
    896891         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5836 r5845  
    22   !!============================================================================== 
    33   !!                       ***  MODULE domzgr   *** 
    4    !! Ocean initialization : domain initialization 
     4   !! Ocean domain : definition of the vertical coordinate system 
    55   !!============================================================================== 
    66   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate 
     
    3838   USE closea            ! closed seas 
    3939   USE c1d               ! 1D vertical configuration 
     40   ! 
    4041   USE in_out_manager    ! I/O manager 
    4142   USE iom               ! I/O library 
     
    7374 
    7475  !! * Substitutions 
    75 #  include "domzgr_substitute.h90" 
    7676#  include "vectopt_loop_substitute.h90" 
    7777   !!---------------------------------------------------------------------- 
     
    157157         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    158158         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   & 
    159             &                   ' w ',   MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gdep3w_0(:,:,:) ) 
     159            &                   ' w ',   MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 
    160160         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ),  & 
    161161            &                   ' u ',   MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ),  & 
     
    164164 
    165165         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   & 
    166             &                   ' w ',   MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gdep3w_0(:,:,:) ) 
     166            &                   ' w ',   MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 
    167167         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ),  & 
    168168            &                   ' u ',   MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ),  & 
     
    674674      !!              - update bathy : meter bathymetry (in meters) 
    675675      !!---------------------------------------------------------------------- 
    676       !! 
    677676      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    678677      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
    679678      REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy 
    680  
    681679      !!---------------------------------------------------------------------- 
    682680      ! 
     
    775773         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1 
    776774      ENDIF 
    777  
    778       IF( lwp .AND. nprint == 1 ) THEN      ! control print 
    779          WRITE(numout,*) 
    780          WRITE(numout,*) ' bathymetric field :   number of non-zero T-levels ' 
    781          WRITE(numout,*) ' ------------------' 
    782          CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout ) 
    783          WRITE(numout,*) 
    784       ENDIF 
    785775      ! 
    786776      CALL wrk_dealloc( jpi, jpj, zbathy ) 
     
    803793      !!                                     (min value = 1 over land) 
    804794      !!---------------------------------------------------------------------- 
    805       !! 
    806795      INTEGER ::   ji, jj   ! dummy loop indices 
    807796      REAL(wp), POINTER, DIMENSION(:,:) ::  zmbk 
     
    835824   END SUBROUTINE zgr_bot_level 
    836825 
    837       SUBROUTINE zgr_top_level 
     826 
     827   SUBROUTINE zgr_top_level 
    838828      !!---------------------------------------------------------------------- 
    839829      !!                    ***  ROUTINE zgr_bot_level  *** 
     
    847837      !!                                     (min value = 1) 
    848838      !!---------------------------------------------------------------------- 
    849       !! 
    850839      INTEGER ::   ji, jj   ! dummy loop indices 
    851840      REAL(wp), POINTER, DIMENSION(:,:) ::  zmik 
     
    881870   END SUBROUTINE zgr_top_level 
    882871 
     872 
    883873   SUBROUTINE zgr_zco 
    884874      !!---------------------------------------------------------------------- 
     
    895885      ! 
    896886      DO jk = 1, jpk 
    897          gdept_0 (:,:,jk) = gdept_1d(jk) 
    898          gdepw_0 (:,:,jk) = gdepw_1d(jk) 
    899          gdep3w_0(:,:,jk) = gdepw_1d(jk) 
    900          e3t_0   (:,:,jk) = e3t_1d  (jk) 
    901          e3u_0   (:,:,jk) = e3t_1d  (jk) 
    902          e3v_0   (:,:,jk) = e3t_1d  (jk) 
    903          e3f_0   (:,:,jk) = e3t_1d  (jk) 
    904          e3w_0   (:,:,jk) = e3w_1d  (jk) 
    905          e3uw_0  (:,:,jk) = e3w_1d  (jk) 
    906          e3vw_0  (:,:,jk) = e3w_1d  (jk) 
     887         gdept_0(:,:,jk) = gdept_1d(jk) 
     888         gdepw_0(:,:,jk) = gdepw_1d(jk) 
     889         gde3w_0(:,:,jk) = gdepw_1d(jk) 
     890         e3t_0  (:,:,jk) = e3t_1d  (jk) 
     891         e3u_0  (:,:,jk) = e3t_1d  (jk) 
     892         e3v_0  (:,:,jk) = e3t_1d  (jk) 
     893         e3f_0  (:,:,jk) = e3t_1d  (jk) 
     894         e3w_0  (:,:,jk) = e3w_1d  (jk) 
     895         e3uw_0 (:,:,jk) = e3w_1d  (jk) 
     896         e3vw_0 (:,:,jk) = e3w_1d  (jk) 
    907897      END DO 
    908898      ! 
     
    957947      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    958948      !!---------------------------------------------------------------------- 
    959       !! 
    960949      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    961950      INTEGER  ::   ik, it, ikb, ikt ! temporary integers 
    962       LOGICAL  ::   ll_print         ! Allow  control print for debugging 
    963951      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    964952      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
     
    977965      IF(lwp) WRITE(numout,*) '    ~~~~~~~ ' 
    978966      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used' 
    979  
    980       ll_print = .FALSE.                   ! Local variable for debugging 
    981        
    982       IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
    983          WRITE(numout,*) 
    984          WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)' 
    985          CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout ) 
    986       ENDIF 
    987  
    988967 
    989968      ! bathymetry in level (from bathy_meter) 
     
    11961175      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
    11971176      
    1198       ! Compute gdep3w_0 (vertical sum of e3w) 
     1177      ! Compute gde3w_0 (vertical sum of e3w) 
    11991178      IF ( ln_isfcav ) THEN ! if cavity 
    12001179         WHERE (misfdep == 0) misfdep = 1 
    12011180         DO jj = 1,jpj 
    12021181            DO ji = 1,jpi 
    1203                gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
     1182               gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
    12041183               DO jk = 2, misfdep(ji,jj) 
    1205                   gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1184                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    12061185               END DO 
    1207                IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
     1186               IF (misfdep(ji,jj) .GE. 2) gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
    12081187               DO jk = misfdep(ji,jj) + 1, jpk 
    1209                   gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1188                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    12101189               END DO 
    12111190            END DO 
    12121191         END DO 
    12131192      ELSE ! no cavity 
    1214          gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
     1193         gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
    12151194         DO jk = 2, jpk 
    1216             gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
     1195            gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
    12171196         END DO 
    12181197      END IF 
    1219       !                                               ! ================= ! 
    1220       IF(lwp .AND. ll_print) THEN                     !   Control print   ! 
    1221          !                                            ! ================= ! 
    1222          DO jj = 1,jpj 
    1223             DO ji = 1, jpi 
    1224                ik = MAX( mbathy(ji,jj), 1 ) 
    1225                zprt(ji,jj,1) = e3t_0   (ji,jj,ik) 
    1226                zprt(ji,jj,2) = e3w_0   (ji,jj,ik) 
    1227                zprt(ji,jj,3) = e3u_0   (ji,jj,ik) 
    1228                zprt(ji,jj,4) = e3v_0   (ji,jj,ik) 
    1229                zprt(ji,jj,5) = e3f_0   (ji,jj,ik) 
    1230                zprt(ji,jj,6) = gdep3w_0(ji,jj,ik) 
    1231             END DO 
    1232          END DO 
    1233          WRITE(numout,*) 
    1234          WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1235          WRITE(numout,*) 
    1236          WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1237          WRITE(numout,*) 
    1238          WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1239          WRITE(numout,*) 
    1240          WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1241          WRITE(numout,*) 
    1242          WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1243          WRITE(numout,*) 
    1244          WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1245       ENDIF   
    12461198      ! 
    12471199      CALL wrk_dealloc( jpi, jpj, jpk, zprt ) 
     
    12501202      ! 
    12511203   END SUBROUTINE zgr_zps 
     1204 
    12521205 
    12531206   SUBROUTINE zgr_isf 
     
    12651218      !!              - bathy and isfdraft are modified 
    12661219      !!---------------------------------------------------------------------- 
    1267       !!    
    12681220      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    12691221      INTEGER  ::   ik, it           ! temporary integers 
    12701222      INTEGER  ::   id, jd, nprocd 
    12711223      INTEGER  ::   icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF) 
    1272       LOGICAL  ::   ll_print         ! Allow  control print for debugging 
    12731224      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    12741225      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
     
    17521703      CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 
    17531704      CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 
    1754  
     1705      ! 
    17551706      IF( nn_timing == 1 )  CALL timing_stop('zgr_isf') 
    1756        
     1707      !       
    17571708   END SUBROUTINE 
     1709 
    17581710 
    17591711   SUBROUTINE zgr_sco 
     
    18011753      !! 
    18021754      !!---------------------------------------------------------------------- 
    1803       ! 
    18041755      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    18051756      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
     
    18101761      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    18111762      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
    1812  
     1763      !! 
    18131764      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
    1814                            rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
     1765         &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    18151766     !!---------------------------------------------------------------------- 
    18161767      ! 
     
    18761827      DO jj = 1, jpj 
    18771828         DO ji = 1, jpi 
    1878            IF( bathy(ji,jj) == 0._wp ) THEN 
    1879              iip1 = MIN( ji+1, jpi ) 
    1880              ijp1 = MIN( jj+1, jpj ) 
    1881              iim1 = MAX( ji-1, 1 ) 
    1882              ijm1 = MAX( jj-1, 1 ) 
    1883              IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              & 
    1884         &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 
    1885                zenv(ji,jj) = rn_sbot_min 
    1886              ENDIF 
     1829            IF( bathy(ji,jj) == 0._wp ) THEN 
     1830               iip1 = MIN( ji+1, jpi ) 
     1831               ijp1 = MIN( jj+1, jpj ) 
     1832               iim1 = MAX( ji-1, 1 ) 
     1833               ijm1 = MAX( jj-1, 1 ) 
     1834!!gm BUG fix see ticket #1617 
     1835               IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)            & 
     1836                  &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )            & 
     1837                  &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp )   zenv(ji,jj) = rn_sbot_min 
     1838!!gm 
     1839!!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         & 
     1840!!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 
     1841!!gm               zenv(ji,jj) = rn_sbot_min 
     1842!!gm             ENDIF 
     1843!!gm end 
    18871844           ENDIF 
    18881845         END DO 
     
    19751932      ENDIF 
    19761933      ! 
    1977       IF(lwp) THEN                             ! Control print 
    1978          WRITE(numout,*) 
    1979          WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters' 
    1980          WRITE(numout,*) 
    1981          CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout ) 
    1982          IF( nprint == 1 )   THEN         
    1983             WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) ) 
    1984             WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) ) 
    1985          ENDIF 
    1986       ENDIF 
    1987  
    19881934      !                                        ! ============================== 
    19891935      !                                        !   hbatu, hbatv, hbatf fields 
     
    20812027      CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    20822028 
    2083       fsdepw(:,:,:) = gdepw_0 (:,:,:) 
    2084       fsde3w(:,:,:) = gdep3w_0(:,:,:) 
    2085       ! 
    2086       where (e3t_0   (:,:,:).eq.0.0)  e3t_0(:,:,:) = 1.0 
    2087       where (e3u_0   (:,:,:).eq.0.0)  e3u_0(:,:,:) = 1.0 
    2088       where (e3v_0   (:,:,:).eq.0.0)  e3v_0(:,:,:) = 1.0 
    2089       where (e3f_0   (:,:,:).eq.0.0)  e3f_0(:,:,:) = 1.0 
    2090       where (e3w_0   (:,:,:).eq.0.0)  e3w_0(:,:,:) = 1.0 
    2091       where (e3uw_0  (:,:,:).eq.0.0)  e3uw_0(:,:,:) = 1.0 
    2092       where (e3vw_0  (:,:,:).eq.0.0)  e3vw_0(:,:,:) = 1.0 
     2029      gdepw_n(:,:,:) = gdepw_0(:,:,:) 
     2030      ! 
     2031      WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp 
     2032      WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp 
     2033      WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp 
     2034      WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp 
     2035      WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp 
     2036      WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp 
     2037      WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp 
    20932038 
    20942039#if defined key_agrif 
    2095       ! Ensure meaningful vertical scale factors in ghost lines/columns 
    2096       IF( .NOT. Agrif_Root() ) THEN 
    2097          !   
    2098          IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    2099             e3u_0(1,:,:) = e3u_0(2,:,:) 
    2100          ENDIF 
    2101          ! 
    2102          IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    2103             e3u_0(nlci-1,:,:) = e3u_0(nlci-2,:,:) 
    2104          ENDIF 
    2105          ! 
    2106          IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    2107             e3v_0(:,1,:) = e3v_0(:,2,:) 
    2108          ENDIF 
    2109          ! 
    2110          IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    2111             e3v_0(:,nlcj-1,:) = e3v_0(:,nlcj-2,:) 
    2112          ENDIF 
    2113          ! 
    2114       ENDIF 
     2040      IF( .NOT. Agrif_Root() ) THEN    ! Ensure meaningful vertical scale factors in ghost lines/columns 
     2041         IF( nbondi == -1 .OR. nbondi == 2 )   e3u_0(  1   ,  :   ,:) = e3u_0(  2   ,  :   ,:) 
     2042         IF( nbondi ==  1 .OR. nbondi == 2 )   e3u_0(nlci-1,  :   ,:) = e3u_0(nlci-2,  :   ,:) 
     2043         IF( nbondj == -1 .OR. nbondj == 2 )   e3v_0(  :   ,  1   ,:) = e3v_0(  :   ,  2   ,:) 
     2044         IF( nbondj ==  1 .OR. nbondj == 2 )   e3v_0(  :   ,nlcj-1,:) = e3v_0(  :   ,nlcj-2,:) 
     2045       ENDIF 
    21152046#endif 
    21162047 
    2117       fsdept(:,:,:) = gdept_0 (:,:,:) 
    2118       fsdepw(:,:,:) = gdepw_0 (:,:,:) 
    2119       fsde3w(:,:,:) = gdep3w_0(:,:,:) 
    2120       fse3t (:,:,:) = e3t_0   (:,:,:) 
    2121       fse3u (:,:,:) = e3u_0   (:,:,:) 
    2122       fse3v (:,:,:) = e3v_0   (:,:,:) 
    2123       fse3f (:,:,:) = e3f_0   (:,:,:) 
    2124       fse3w (:,:,:) = e3w_0   (:,:,:) 
    2125       fse3uw(:,:,:) = e3uw_0 (:,:,:) 
    2126       fse3vw(:,:,:) = e3vw_0 (:,:,:) 
     2048      gdept_n(:,:,:) = gdept_0(:,:,:) 
     2049      gdepw_n(:,:,:) = gdepw_0(:,:,:) 
     2050      gde3w_n(:,:,:) = gde3w_0(:,:,:) 
     2051      e3t_n  (:,:,:) = e3t_0  (:,:,:) 
     2052      e3u_n  (:,:,:) = e3u_0  (:,:,:) 
     2053      e3v_n  (:,:,:) = e3v_0  (:,:,:) 
     2054      e3f_n  (:,:,:) = e3f_0  (:,:,:) 
     2055      e3w_n  (:,:,:) = e3w_0  (:,:,:) 
     2056      e3uw_n (:,:,:) = e3uw_0 (:,:,:) 
     2057      e3vw_n (:,:,:) = e3vw_0 (:,:,:) 
    21272058!! 
    21282059      ! HYBRID :  
     
    21302061         DO ji = 1, jpi 
    21312062            DO jk = 1, jpkm1 
    2132                IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
     2063               IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
    21332064            END DO 
    21342065            IF( scobot(ji,jj) == 0._wp               )   mbathy(ji,jj) = 0 
     
    21412072         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    21422073         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   & 
    2143             &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gdep3w_0(:,:,:) ) 
    2144          WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0   (:,:,:) ),   & 
    2145             &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0   (:,:,:) ),   & 
    2146             &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0  (:,:,:) ),   & 
     2074            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gde3w_0(:,:,:) ) 
     2075         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   & 
     2076            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   & 
     2077            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   & 
    21472078            &                          ' w ', MINVAL( e3w_0  (:,:,:) ) 
    21482079 
    21492080         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   & 
    2150             &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gdep3w_0(:,:,:) ) 
    2151          WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0   (:,:,:) ),   & 
    2152             &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0   (:,:,:) ),   & 
    2153             &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0  (:,:,:) ),   & 
     2081            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gde3w_0(:,:,:) ) 
     2082         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   & 
     2083            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   & 
     2084            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   & 
    21542085            &                          ' w ', MAXVAL( e3w_0  (:,:,:) ) 
    21552086      ENDIF 
     
    21932124               DO jk = 1, mbathy(ji,jj) 
    21942125                 ! check coordinate is monotonically increasing 
    2195                  IF (fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN 
     2126                 IF (e3w_n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN 
    21962127                    WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk 
    21972128                    WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk 
    2198                     WRITE(numout,*) 'e3w',fse3w(ji,jj,:) 
    2199                     WRITE(numout,*) 'e3t',fse3t(ji,jj,:) 
     2129                    WRITE(numout,*) 'e3w',e3w_n(ji,jj,:) 
     2130                    WRITE(numout,*) 'e3t',e3t_n(ji,jj,:) 
    22002131                    CALL ctl_stop( ctmp1 ) 
    22012132                 ENDIF 
    22022133                 ! and check it has never gone negative 
    2203                  IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN 
     2134                 IF( gdepw_n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN 
    22042135                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk 
    22052136                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk 
    2206                     WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:) 
    2207                     WRITE(numout,*) 'gdept',fsdept(ji,jj,:) 
     2137                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 
     2138                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 
    22082139                    CALL ctl_stop( ctmp1 ) 
    22092140                 ENDIF 
    22102141                 ! and check it never exceeds the total depth 
    2211                  IF( fsdepw(ji,jj,jk) > hbatt(ji,jj) ) THEN 
     2142                 IF( gdepw_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 
    22122143                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk 
    22132144                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2214                     WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:) 
     2145                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 
    22152146                    CALL ctl_stop( ctmp1 ) 
    22162147                 ENDIF 
     
    22192150               DO jk = 1, mbathy(ji,jj)-1 
    22202151                 ! and check it never exceeds the total depth 
    2221                 IF( fsdept(ji,jj,jk) > hbatt(ji,jj) ) THEN 
     2152                IF( gdept_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 
    22222153                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk 
    22232154                    WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2224                     WRITE(numout,*) 'gdept',fsdept(ji,jj,:) 
     2155                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 
    22252156                    CALL ctl_stop( ctmp1 ) 
    22262157                 ENDIF 
     
    22972228               zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
    22982229               zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
    2299                gdept_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 
    2300                gdepw_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 
    2301                gdep3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 
     2230               gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 
     2231               gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 
     2232               gde3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 
    23022233            END DO 
    23032234           ! 
     
    24252356 
    24262357          DO jk = 1, jpk 
    2427              gdept_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk) 
    2428              gdepw_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk) 
    2429              gdep3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk) 
     2358             gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk) 
     2359             gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk) 
     2360             gde3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk) 
    24302361          END DO 
    24312362 
     
    24852416      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    24862417      !!---------------------------------------------------------------------- 
    2487  
    2488       INTEGER  ::   ji, jj, jk           ! dummy loop argument 
     2418      INTEGER  ::   ji, jj, jk       ! dummy loop argument 
    24892419      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars 
    2490  
    24912420      REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 
    24922421      REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw 
    2493  
    2494       CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      ) 
    2495       CALL wrk_alloc( jpk, z_esigt, z_esigw                                               ) 
     2422      !!---------------------------------------------------------------------- 
     2423 
     2424      CALL wrk_alloc( jpk,   z_gsigw, z_gsigt, z_gsi3w ) 
     2425      CALL wrk_alloc( jpk,   z_esigt, z_esigw ) 
    24962426 
    24972427      z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp   ;   z_gsi3w  = 0._wp 
     
    25232453         zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
    25242454         zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
    2525          gdept_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft ) 
    2526          gdepw_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw ) 
    2527          gdep3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft ) 
     2455         gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft ) 
     2456         gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw ) 
     2457         gde3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft ) 
    25282458      END DO 
    25292459!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) 
     
    25422472         END DO 
    25432473      END DO 
    2544  
    2545       CALL wrk_dealloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      ) 
    2546       CALL wrk_dealloc( jpk, z_esigt, z_esigw                                               ) 
    2547  
     2474      ! 
     2475      CALL wrk_dealloc( jpk,   z_gsigw, z_gsigt, z_gsi3w ) 
     2476      CALL wrk_dealloc( jpk,   z_esigt, z_esigw          ) 
     2477      ! 
    25482478   END SUBROUTINE s_tanh 
     2479 
    25492480 
    25502481   FUNCTION fssig( pk ) RESULT( pf ) 
     
    26182549      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate 
    26192550      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate 
    2620       REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth 
    2621       REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth 
    2622       REAL(wp), INTENT(in   ) ::   psmth       ! Smoothing parameter 
    2623       REAL(wp)                ::   za1,za2,za3    ! local variables 
    2624       REAL(wp)                ::   zn1,zn2        ! local variables 
    2625       REAL(wp)                ::   za,zb,zx       ! local variables 
    2626       integer                 ::   jk 
    2627       !!---------------------------------------------------------------------- 
    2628       ! 
    2629  
    2630       zn1  =  1./(jpk-1.) 
     2551      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth 
     2552      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth 
     2553      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter 
     2554      ! 
     2555      INTEGER  ::   jk             ! dummy loop index 
     2556      REAL(wp) ::   za1,za2,za3    ! local scalar 
     2557      REAL(wp) ::   zn1,zn2        !   -      -  
     2558      REAL(wp) ::   za,zb,zx       !   -      -  
     2559      !!---------------------------------------------------------------------- 
     2560      ! 
     2561      zn1  =  1._wp / REAL( jpkm1, wp ) 
    26312562      zn2  =  1. -  zn1 
    2632  
     2563      ! 
    26332564      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp)  
    26342565      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp) 
    26352566      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1) 
    2636       
     2567      ! 
    26372568      za = pzb - za3*(pzs-za1)-za2 
    26382569      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) ) 
    26392570      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1) 
    26402571      zx = 1.0_wp-za/2.0_wp-zb 
    2641   
     2572      ! 
    26422573      DO jk = 1, jpk 
    2643         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  & 
    2644                     & zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- & 
    2645                     &      (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 
     2574         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  & 
     2575            &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- & 
     2576            &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 
    26462577        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth) 
    2647       ENDDO  
    2648  
     2578      END DO 
    26492579      ! 
    26502580   END FUNCTION fgamma 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r5836 r5845  
    3535   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read) 
    3636 
    37    !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    250248      ENDIF 
    251249      ! 
    252       IF( lwp .AND. kt == nit000 ) THEN 
    253          WRITE(numout,*) ' temperature Levitus ' 
    254          WRITE(numout,*) 
    255          WRITE(numout,*)'  level = 1' 
    256          CALL prihre( ptsd(:,:,1    ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    257          WRITE(numout,*)'  level = ', jpk/2 
    258          CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    259          WRITE(numout,*)'  level = ', jpkm1 
    260          CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    261          WRITE(numout,*) 
    262          WRITE(numout,*) ' salinity Levitus ' 
    263          WRITE(numout,*) 
    264          WRITE(numout,*)'  level = 1' 
    265          CALL prihre( ptsd(:,:,1    ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    266          WRITE(numout,*)'  level = ', jpk/2 
    267          CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    268          WRITE(numout,*)'  level = ', jpkm1 
    269          CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    270          WRITE(numout,*) 
    271       ENDIF 
    272       ! 
    273250      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==!  
    274251         !                                              (data used only for initialisation) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5836 r5845  
    5252 
    5353   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5554#  include "vectopt_loop_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
     
    124123         ENDIF 
    125124         !    
    126          ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here 
     125         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
    127126         IF( lk_vvl ) THEN 
    128127            DO jk = 1, jpk 
    129                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     128               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    130129            END DO 
    131130         ENDIF 
     
    155154         DO jj = 1, jpj 
    156155            DO ji = 1, jpi 
    157                un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    158                vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     156               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     157               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    159158               ! 
    160                ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    161                vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     159               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     160               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    162161            END DO 
    163162         END DO 
    164163      END DO 
    165164      ! 
    166       un_b(:,:) = un_b(:,:) * hur  (:,:) 
    167       vn_b(:,:) = vn_b(:,:) * hvr  (:,:) 
    168       ! 
    169       ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 
    170       vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 
     165      un_b(:,:) = un_b(:,:) * r1_hu_n  (:,:) 
     166      vn_b(:,:) = vn_b(:,:) * r1_hv_n  (:,:) 
     167      ! 
     168      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
     169      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    171170      ! 
    172171      ! 
     
    197196      ! 
    198197      DO jk = 1, jpk 
    199          tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   & 
    200             &                + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.)  ) * tmask(:,:,jk) 
     198         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) )   & 
     199            &                + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.)  ) * tmask(:,:,jk) 
    201200         tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    202201      END DO 
     
    251250            ! 
    252251            DO jk = 1, jpk 
    253                tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
     252               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
    254253               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    255254            END DO 
    256             ! 
    257             IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
    258                &                             1     , jpi   , 5     , 1     , jpk   ,   & 
    259                &                             1     , 1.    , numout                  ) 
    260255            ! 
    261256            ! set salinity field to a constant value 
     
    327322            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb 
    328323            ! 
    329             IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
    330                &                            1     , jpi   , 5     , 1     , jpk   ,   & 
    331                &                            1     , 1.    , numout                  ) 
    332             ! 
    333324            ! set salinity field to a constant value 
    334325            ! -------------------------------------- 
     
    376367            DO jj = 1, jpj 
    377368               DO ji = 1, jpi 
    378                   tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   & 
    379                        &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               & 
    380                        &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       & 
    381                        &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &     
    382                        &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   &  
    383                        &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
     369                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 )         )   & 
     370                       &           * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2               & 
     371                       &       + (      15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) )       & 
     372                       &                - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.)               &     
     373                       &                + 7.  * (1500. - gdept_n(ji,jj,jk)) / 1500.             )   &  
     374                       &           * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 
    384375                  tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    385376                  tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 
    386377 
    387                   tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  & 
    388                      &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          & 
    389                      &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         & 
    390                      &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       & 
    391                      &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       & 
    392                      &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  & 
    393                      &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2  
     378                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 )  )  & 
     379                     &              * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2          & 
     380                     &          + (  35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000.         & 
     381                     &                - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60.  ) / 650. )       & 
     382                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 35.  ) / 100. )       & 
     383                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.)    )  & 
     384                     &              * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2  
    394385                  tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    395386                  tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) 
     
    466457      zalfg = 0.5 * grav * rau0 
    467458       
    468       zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value 
     459      zprn(:,:,1) = zalfg * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value 
    469460 
    470461      DO jk = 2, jpkm1                                              ! Vertical integration from the surface 
    471462         zprn(:,:,jk) = zprn(:,:,jk-1)   & 
    472             &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) ) 
     463            &         + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) ) 
    473464      END DO   
    474465 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r5836 r5845  
    3636 
    3737   !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
     
    7473         DO jj = 2, jpjm1 
    7574            DO ji = fs_2, fs_jpim1   ! vector opt. 
    76                hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        & 
    77                   &               - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        & 
    78                   &               + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        & 
    79                   &               - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    & 
    80                   &            / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     75               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        & 
     76                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        & 
     77                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        & 
     78                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    & 
     79                  &            / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    8180            END DO   
    8281         END DO   
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r5836 r5845  
    3939 
    4040   !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    4241#  include "vectopt_loop_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r5836 r5845  
    3030 
    3131   !! * Substitutions 
    32 #  include "domzgr_substitute.h90" 
    3332#  include "vectopt_loop_substitute.h90" 
    3433   !!---------------------------------------------------------------------- 
     
    7776      DO jk = 1, jpkm1                       ! ====================== ! 
    7877         !                                         ! horizontal volume fluxes 
    79          zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    80          zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     78         zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     79         zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    8180         ! 
    8281         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point 
     
    9089         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    9190            DO ji = fs_2, fs_jpim1   ! vector opt. 
    92                zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
    93                zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     91               zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
     92               zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    9493               ! 
    9594               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
     
    144143            DO ji = fs_2, fs_jpim1   ! vector opt. 
    145144               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    146                   &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     145                  &  / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    147146               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    148                   &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     147                  &  / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    149148            END DO 
    150149         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r5836 r5845  
    3535 
    3636   !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3837#  include "vectopt_loop_substitute.h90" 
    3938   !!---------------------------------------------------------------------- 
     
    111110         !                                   ! =========================== ! 
    112111         !                                         ! horizontal volume fluxes 
    113          zfu(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    114          zfv(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     112         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     113         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    115114         !             
    116115         DO jj = 2, jpjm1                          ! laplacian 
     
    142141      DO jk = 1, jpkm1                       ! ====================== ! 
    143142         !                                         ! horizontal volume fluxes 
    144          zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    145          zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     143         zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     144         zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    146145         ! 
    147146         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point 
     
    181180         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    182181            DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
    184                zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     182               zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
     183               zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    185184               ! 
    186185               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
     
    233232            DO ji = fs_2, fs_jpim1   ! vector opt. 
    234233               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    235                   &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     234                  &  / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    236235               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    237                   &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     236                  &  / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    238237            END DO 
    239238         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r5120 r5845  
    2929 
    3030   !! * Substitutions 
    31 #  include "domzgr_substitute.h90" 
    32 #  include "zdfddm_substitute.h90" 
    3331#  include "vectopt_loop_substitute.h90" 
    3432   !!---------------------------------------------------------------------- 
     
    7876              ! 
    7977              ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    80               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) 
    81               va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) 
     78              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) 
     79              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) 
    8280           END DO 
    8381        END DO 
     
    9189                 ! 
    9290                 ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    93                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) & 
     91                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) & 
    9492                    &             * (1.-umask(ji,jj,1)) 
    95                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) & 
     93                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) & 
    9694                    &             * (1.-vmask(ji,jj,1)) 
    9795                 ! (ISF) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r5836 r5845  
    6363 
    6464   !! * Substitutions 
    65 #  include "domzgr_substitute.h90" 
    6665#  include "vectopt_loop_substitute.h90" 
    6766   !!---------------------------------------------------------------------- 
     
    214213      !!---------------------------------------------------------------------- 
    215214      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    216       !! 
     215      ! 
    217216      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    218217      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
     
    233232      DO jj = 2, jpjm1 
    234233         DO ji = fs_2, fs_jpim1   ! vector opt. 
    235             zcoef1 = zcoef0 * fse3w(ji,jj,1) 
     234            zcoef1 = zcoef0 * e3w_n(ji,jj,1) 
    236235            ! hydrostatic pressure gradient 
    237236            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 
    238237            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 
     238!!gm            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     239!!gm            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    239240            ! add to the general momentum trend 
    240241            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    248249         DO jj = 2, jpjm1 
    249250            DO ji = fs_2, fs_jpim1   ! vector opt. 
    250                zcoef1 = zcoef0 * fse3w(ji,jj,jk) 
     251               zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 
    251252               ! hydrostatic pressure gradient 
    252253               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    253254                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   & 
    254255                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj) 
     256!!gm                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    255257 
    256258               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    257259                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   & 
    258260                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj) 
     261!!gm                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    259262               ! add to the general momentum trend 
    260263               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    300303      DO jj = 2, jpjm1 
    301304         DO ji = fs_2, fs_jpim1   ! vector opt. 
    302             zcoef1 = zcoef0 * fse3w(ji,jj,1) 
     305            zcoef1 = zcoef0 * e3w_n(ji,jj,1) 
    303306            ! hydrostatic pressure gradient 
    304307            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 
    305308            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 
     309!!gm            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     310!!gm            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    306311            ! add to the general momentum trend 
    307312            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    315320         DO jj = 2, jpjm1 
    316321            DO ji = fs_2, fs_jpim1   ! vector opt. 
    317                zcoef1 = zcoef0 * fse3w(ji,jj,jk) 
     322               zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 
    318323               ! hydrostatic pressure gradient 
    319324               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    320325                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   & 
    321326                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj) 
     327!!gm                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    322328 
    323329               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    324330                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   & 
    325331                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj) 
     332!!gm                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    326333               ! add to the general momentum trend 
    327334               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    337344            iku = mbku(ji,jj) 
    338345            ikv = mbkv(ji,jj) 
    339             zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) ) 
    340             zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji  ,jj+1,ikv) ) 
     346            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) ) 
     347            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) ) 
    341348            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more) 
    342349               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value 
    343350               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one 
    344351                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj) 
     352!!gm                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj) 
    345353               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend 
    346354            ENDIF 
     
    349357               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one 
    350358                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj) 
     359!!gm                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj) 
    351360               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
    352361            ENDIF 
     
    402411         DO ji = fs_2, fs_jpim1   ! vector opt. 
    403412            ! hydrostatic pressure gradient along s-surfaces 
    404             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
    405                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    406             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
    407                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
     413!!gm            zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
     414            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
     415               &                                     - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
     416!!gm            zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
     417            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
     418               &                                     - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    408419            ! s-coordinate pressure gradient correction 
    409             zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    410                &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 
    411             zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    412                &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
     420            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     421               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) / e1u(ji,jj) 
     422!!gm               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 
     423            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     424               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) / e2v(ji,jj) 
     425!!gm               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    413426            ! add to the general momentum trend 
    414427            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
     
    422435            DO ji = fs_2, fs_jpim1   ! vector opt. 
    423436               ! hydrostatic pressure gradient along s-surfaces 
     437!!gm               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    424438               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    425                   &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    426                   &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    427                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    428                   &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
    429                   &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
     439                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
     440                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
     441!!gm               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
     442               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   & 
     443                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
     444                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    430445               ! s-coordinate pressure gradient correction 
    431                zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    432                   &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) 
    433                zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    434                   &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 
     446               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
     447                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) 
     448!!gm                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) 
     449               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
     450                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) 
     451!!gm                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 
    435452               ! add to the general momentum trend 
    436453               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
     
    528545         DO ji = 1, jpi   ! vector opt. 
    529546            ikt=mikt(ji,jj) 
    530             ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * fse3w(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
     547            ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    531548            DO jk=2,ikt-1 
    532                ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * fse3w(ji,jj,jk) & 
     549               ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    533550                  &                              * (1._wp - tmask(ji,jj,jk)) 
    534551            END DO 
     
    544561            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
    545562            ! we assume ISF is in isostatic equilibrium 
    546             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * fse3w(ji+1,jj  ,iktp1i)                                    & 
     563!!gm            zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj  ,iktp1i)                                    & 
     564            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj  ,iktp1i)                                    & 
    547565               &                                  * ( 2._wp * znad + rhd(ji+1,jj  ,iktp1i) + zrhdtop_oce(ji+1,jj  ) )   & 
    548                &                                  - 0.5_wp * fse3w(ji  ,jj  ,ikt   )                                    & 
     566               &                                  - 0.5_wp * e3w_n(ji  ,jj  ,ikt   )                                    & 
    549567               &                                  * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   & 
    550568               &                                  + ( ziceload(ji+1,jj) - ziceload(ji,jj))                              )  
    551             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * fse3w(ji  ,jj+1,iktp1j)                                    & 
     569!!gm            zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( 0.5_wp * e3w_n(ji  ,jj+1,iktp1j)                                    & 
     570            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji  ,jj+1,iktp1j)                                    & 
    552571               &                                  * ( 2._wp * znad + rhd(ji  ,jj+1,iktp1j) + zrhdtop_oce(ji  ,jj+1) )   & 
    553                &                                  - 0.5_wp * fse3w(ji  ,jj  ,ikt   )                                    &  
     572               &                                  - 0.5_wp * e3w_n(ji  ,jj  ,ikt   )                                    &  
    554573               &                                  * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   & 
    555574               &                                  + ( ziceload(ji,jj+1) - ziceload(ji,jj) )                             )  
    556575            ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    557             zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    558                &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 
    559             zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    560                &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
     576            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     577               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) / e1u(ji,jj) 
     578!!gm               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 
     579            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     580               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) / e2v(ji,jj) 
     581!!gm               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    561582            ! add to the general momentum trend 
    562583            ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) 
     
    569590      DO jj = 2, jpjm1 
    570591         DO ji = fs_2, fs_jpim1   ! vector opt. 
    571             iku = miku(ji,jj) ;  
    572             zpshpi(ji,jj)=0.0_wp ; zpshpj(ji,jj)=0.0_wp 
     592            iku = miku(ji,jj) 
     593            zpshpi(ji,jj) = 0._wp   ;   zpshpj(ji,jj) = 0._wp 
    573594            ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
    574595            ! u direction 
    575596            IF ( iku .GT. 1 ) THEN 
    576597               ! case iku 
     598!!gm               zhpi(ji,jj,iku)   =  zcoef0 * r1_e1u(ji,jj) * ze3wu                                            & 
    577599               zhpi(ji,jj,iku)   =  zcoef0 / e1u(ji,jj) * ze3wu                                            & 
    578600                      &                                 * ( rhd    (ji+1,jj,iku) + rhd   (ji,jj,iku)       & 
    579601                      &                                   + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 
    580602               ! corrective term ( = 0 if z coordinate ) 
     603!!gm               zuap              = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 
    581604               zuap              = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) / e1u(ji,jj) 
    582605               ! zhpi will be added in interior loop 
     
    586609 
    587610               ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps) 
     611!!gm               zhpiint        =  zcoef0 * r1_e1u(ji,jj)                                                               &     
    588612               zhpiint        =  zcoef0 / e1u(ji,jj)                                                               &     
    589                   &           * (  fse3w(ji+1,jj  ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad)                          & 
     613                  &           * (  e3w_n(ji+1,jj  ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad)                          & 
    590614                  &                                         + (rhd(ji+1,jj,iku  ) + znad) ) * tmask(ji+1,jj,iku)   & 
    591                   &              - fse3w(ji  ,jj  ,iku+1) * ( (rhd(ji  ,jj,iku+1) + znad)                          & 
     615                  &              - e3w_n(ji  ,jj  ,iku+1) * ( (rhd(ji  ,jj,iku+1) + znad)                          & 
    592616                  &                                         + (rhd(ji  ,jj,iku  ) + znad) ) * tmask(ji  ,jj,iku)   ) 
     617!!gm               zhpi(ji,jj,iku+1) =  zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint  
    593618               zhpi(ji,jj,iku+1) =  zcoef0 / e1u(ji,jj) * ge3rui(ji,jj) - zhpiint  
    594619            END IF 
     
    599624            IF ( ikv .GT. 1 ) THEN 
    600625               ! case ikv 
     626!!gm               zhpj(ji,jj,ikv)   =  zcoef0 * r1_e2v(ji,jj) * ze3wv                                            & 
    601627               zhpj(ji,jj,ikv)   =  zcoef0 / e2v(ji,jj) * ze3wv                                            & 
    602628                     &                                  * ( rhd(ji,jj+1,ikv) + rhd   (ji,jj,ikv)           & 
    603629                     &                                    + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 
    604630               ! corrective term ( = 0 if z coordinate ) 
     631!!gm               zvap              = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 
    605632               zvap              = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) / e2v(ji,jj) 
    606633               ! zhpi will be added in interior loop 
     
    610637                
    611638               ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps) 
     639!!gm               zhpjint        =  zcoef0 * r1_e2v(ji,jj)                                                              & 
    612640               zhpjint        =  zcoef0 / e2v(ji,jj)                                                              & 
    613                   &           * (  fse3w(ji  ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad)                         & 
     641                  &           * (  e3w_n(ji  ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad)                         & 
    614642                  &                                       + (rhd(ji,jj+1,ikv  ) + znad) ) * tmask(ji,jj+1,ikv)    & 
    615                   &              - fse3w(ji  ,jj  ,ikv+1) * ( (rhd(ji,jj  ,ikv+1) + znad)                         & 
     643                  &              - e3w_n(ji  ,jj  ,ikv+1) * ( (rhd(ji,jj  ,ikv+1) + znad)                         & 
    616644                  &                                       + (rhd(ji,jj  ,ikv  ) + znad) ) * tmask(ji,jj  ,ikv)  ) 
     645!!gm               zhpj(ji,jj,ikv+1) =  zcoef0 * r1_e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 
    617646               zhpj(ji,jj,ikv+1) =  zcoef0 / e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 
    618647            END IF 
     
    626655      DO jj = 2, jpjm1 
    627656         DO ji = fs_2, fs_jpim1   ! vector opt. 
     657!!gm useles ! 
    628658            iku=miku(ji,jj); ikv=mikv(ji,jj) 
     659!!gm 
    629660            DO jk = 2, jpkm1 
    630661               ! hydrostatic pressure gradient along s-surfaces 
    631662               ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc) 
    632                zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1)                                                              & 
    633                   &                            + zcoef0 / e1u(ji,jj)                                                           & 
    634                   &                                     * ( fse3w(ji+1,jj  ,jk) * ( (rhd(ji+1,jj,jk  ) + znad)                 & 
    635                   &                                                     + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1)   & 
    636                   &                                       - fse3w(ji  ,jj  ,jk) * ( (rhd(ji  ,jj,jk  ) + znad)                 & 
    637                   &                                                     + (rhd(ji  ,jj,jk-1) + znad) ) * tmask(ji  ,jj,jk-1)   )  
     663               zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1)                                                     & 
     664!!gm                  &           + zcoef0 * r1_e1u(ji,jj)                                                                & 
     665                  &           + zcoef0 / e1u(ji,jj)                                                                & 
     666                  &                    * ( e3w_n(ji+1,jj,jk) * ( (rhd(ji+1,jj,jk  ) + znad)                           & 
     667                  &                                            + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1)   & 
     668                  &                      - e3w_n(ji  ,jj,jk) * ( (rhd(ji  ,jj,jk  ) + znad)                           & 
     669                  &                                            + (rhd(ji  ,jj,jk-1) + znad) ) * tmask(ji  ,jj,jk-1)   )  
    638670               ! s-coordinate pressure gradient correction 
    639671               ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc)  
    640                zuap = - zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )                    & 
    641                   &            * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk-1) 
     672               zuap = - zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )                    & 
     673                  &            * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk-1) 
     674!!gm                  &            * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk-1) 
    642675               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
    643676 
    644677               ! hydrostatic pressure gradient along s-surfaces 
    645678               ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc) 
    646                zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1)                                                              & 
    647                   &                            + zcoef0 / e2v(ji,jj)                                                           & 
    648                   &                                     * ( fse3w(ji  ,jj+1,jk) * ( (rhd(ji,jj+1,jk  ) + znad)                 & 
    649                   &                                                     + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1)   & 
    650                   &                                       - fse3w(ji  ,jj  ,jk) * ( (rhd(ji,jj  ,jk  ) + znad)                 & 
    651                   &                                                     + (rhd(ji,jj  ,jk-1) + znad) ) * tmask(ji,jj  ,jk-1)   ) 
     679               zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1)                                                     & 
     680!!gm                  &           + zcoef0 * r1_e2v(ji,jj)                                                                & 
     681                  &           + zcoef0 / e2v(ji,jj)                                                                & 
     682                  &                    * ( e3w_n(ji  ,jj+1,jk) * ( (rhd(ji,jj+1,jk  ) + znad)                           & 
     683                  &                                              + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1)   & 
     684                  &                      - e3w_n(ji  ,jj  ,jk) * ( (rhd(ji,jj  ,jk  ) + znad)                           & 
     685                  &                                              + (rhd(ji,jj  ,jk-1) + znad) ) * tmask(ji,jj  ,jk-1)   ) 
    652686               ! s-coordinate pressure gradient correction 
    653687               ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc) 
    654                zvap = - zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )                     & 
    655                   &            * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk-1) 
     688               zvap = - zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )                    & 
     689                  &            * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk-1) 
     690!!gm                  &            * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk-1) 
    656691               ! add to the general momentum trend 
    657692               va(ji,jj,jk) = va(ji,jj,jk) + ( zhpj(ji,jj,jk) + zvap ) * vmask(ji,jj,jk) 
     
    671706            IF (iku .GT. 1) THEN 
    672707               ! remove old value (interior case) 
    673                zuap            = -zcoef0 * ( rhd   (ji+1,jj  ,iku) + rhd   (ji,jj,iku) + 2._wp * znad )   & 
    674                      &                   * ( fsde3w(ji+1,jj  ,iku) - fsde3w(ji,jj,iku) ) / e1u(ji,jj) 
     708               zuap            = -zcoef0 * ( rhd    (ji+1,jj  ,iku) + rhd    (ji,jj,iku) + 2._wp * znad )   & 
     709                     &                   * ( gde3w_n(ji+1,jj  ,iku) - gde3w_n(ji,jj,iku) ) / e1u(ji,jj) 
     710!!gm                     &                   * ( gde3w_n(ji+1,jj  ,iku) - gde3w_n(ji,jj,iku) ) * r1_e1u(ji,jj) 
    675711               ua(ji,jj,iku)   = ua(ji,jj,iku) - zhpi(ji,jj,iku) - zuap 
    676712               ! put new value 
    677713               ! -zpshpi to avoid double contribution of the partial step in the top layer  
     714!!gm               zuap            = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj)  * r1_e1u(ji,jj) 
    678715               zuap            = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj)  / e1u(ji,jj) 
    679716               zhpi(ji,jj,iku) =  zhpi(ji,jj,iku-1) + zcoef0 / e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj)  
     717!!gm               zhpi(ji,jj,iku) =  zhpi(ji,jj,iku-1) + zcoef0 * r1_e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj)  
    680718               ua(ji,jj,iku)   =  ua(ji,jj,iku) + zhpi(ji,jj,iku) + zuap 
    681719            END IF 
     
    683721            IF (ikv .GT. 1) THEN 
    684722               ! remove old value (interior case) 
    685                zvap            = -zcoef0 * ( rhd   (ji  ,jj+1,ikv) + rhd   (ji,jj,ikv) + 2._wp * znad )   & 
    686                      &                   * ( fsde3w(ji  ,jj+1,ikv) - fsde3w(ji,jj,ikv) )   / e2v(ji,jj) 
     723               zvap            = -zcoef0 * ( rhd    (ji  ,jj+1,ikv) + rhd    (ji,jj,ikv) + 2._wp * znad )   & 
     724                     &                   * ( gde3w_n(ji  ,jj+1,ikv) - gde3w_n(ji,jj,ikv) )   / e2v(ji,jj) 
     725!!gm                     &                   * ( gde3w_n(ji  ,jj+1,ikv) - gde3w_n(ji,jj,ikv) )   * r1_e2v(ji,jj) 
    687726               va(ji,jj,ikv)   = va(ji,jj,ikv) - zhpj(ji,jj,ikv) - zvap 
    688727               ! put new value 
    689728               ! -zpshpj to avoid double contribution of the partial step in the top layer  
     729!!gm               zvap            = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj)     * r1_e2v(ji,jj) 
    690730               zvap            = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj)     / e2v(ji,jj) 
    691731               zhpj(ji,jj,ikv) =  zhpj(ji,jj,ikv-1) + zcoef0 / e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj)    
     732!!gm               zhpj(ji,jj,ikv) =  zhpj(ji,jj,ikv-1) + zcoef0 * r1_e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj)    
    692733               va(ji,jj,ikv)   =  va(ji,jj,ikv) + zhpj(ji,jj,ikv) + zvap 
    693734            END IF 
     
    750791         DO jj = 2, jpjm1 
    751792            DO ji = fs_2, fs_jpim1   ! vector opt. 
    752                drhoz(ji,jj,jk) = rhd   (ji  ,jj  ,jk) - rhd   (ji,jj,jk-1) 
    753                dzz  (ji,jj,jk) = fsde3w(ji  ,jj  ,jk) - fsde3w(ji,jj,jk-1) 
    754                drhox(ji,jj,jk) = rhd   (ji+1,jj  ,jk) - rhd   (ji,jj,jk  ) 
    755                dzx  (ji,jj,jk) = fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk  ) 
    756                drhoy(ji,jj,jk) = rhd   (ji  ,jj+1,jk) - rhd   (ji,jj,jk  ) 
    757                dzy  (ji,jj,jk) = fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk  ) 
     793               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1) 
     794               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1) 
     795               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
     796               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  ) 
     797               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  ) 
     798               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  ) 
    758799            END DO 
    759800         END DO 
     
    837878      !------------------------------------------------------------- 
    838879 
    839 !!bug gm   :  e3w-de3w = 0.5*e3w  ....  and de3w(2)-de3w(1)=e3w(2) ....   to be verified 
    840 !          true if de3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
     880!!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified 
     881!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
    841882 
    842883      DO jj = 2, jpjm1 
    843884         DO ji = fs_2, fs_jpim1   ! vector opt. 
    844             rho_k(ji,jj,1) = -grav * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) )               & 
    845                &                   * (  rhd(ji,jj,1)                                    & 
    846                &                     + 0.5_wp * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         & 
    847                &                              * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   & 
    848                &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  ) 
     885            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               & 
     886               &                   * (  rhd(ji,jj,1)                                     & 
     887               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  & 
     888               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  & 
     889               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  ) 
    849890         END DO 
    850891      END DO 
     
    857898            DO ji = fs_2, fs_jpim1   ! vector opt. 
    858899 
    859                rho_k(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj,jk) + rhd   (ji,jj,jk-1) )                                   & 
    860                   &                     * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) )                                   & 
    861                   &            - grav * z1_10 * (                                                                     & 
    862                   &     ( drhow (ji,jj,jk) - drhow (ji,jj,jk-1) )                                                     & 
    863                   &   * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   & 
    864                   &   - ( dzw   (ji,jj,jk) - dzw   (ji,jj,jk-1) )                                                     & 
    865                   &   * ( rhd   (ji,jj,jk) - rhd   (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   & 
     900               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   & 
     901                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   & 
     902                  &            - grav * z1_10 * (                                                                   & 
     903                  &     ( drhow  (ji,jj,jk) - drhow (ji,jj,jk-1) )                                                     & 
     904                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   & 
     905                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     & 
     906                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   & 
    866907                  &                             ) 
    867908 
    868                rho_i(ji,jj,jk) = zcoef0 * ( rhd   (ji+1,jj,jk) + rhd   (ji,jj,jk) )                                   & 
    869                   &                     * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) )                                   & 
    870                   &            - grav* z1_10 * (                                                                      & 
    871                   &     ( drhou (ji+1,jj,jk) - drhou (ji,jj,jk) )                                                     & 
    872                   &   * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   & 
    873                   &   - ( dzu   (ji+1,jj,jk) - dzu   (ji,jj,jk) )                                                     & 
    874                   &   * ( rhd   (ji+1,jj,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   & 
     909               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   & 
     910                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   & 
     911                  &            - grav* z1_10 * (                                                                    & 
     912                  &     ( drhou  (ji+1,jj,jk) - drhou (ji,jj,jk) )                                                     & 
     913                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   & 
     914                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     & 
     915                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   & 
    875916                  &                            ) 
    876917 
    877                rho_j(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj+1,jk) + rhd   (ji,jj,jk) )                                   & 
    878                   &                     * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) )                                   & 
    879                   &            - grav* z1_10 * (                                                                      & 
    880                   &     ( drhov (ji,jj+1,jk) - drhov (ji,jj,jk) )                                                     & 
    881                   &   * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   & 
    882                   &   - ( dzv   (ji,jj+1,jk) - dzv   (ji,jj,jk) )                                                     & 
    883                   &   * ( rhd   (ji,jj+1,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   & 
     918               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 & 
     919                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   & 
     920                  &            - grav* z1_10 * (                                                                    & 
     921                  &     ( drhov  (ji,jj+1,jk) - drhov (ji,jj,jk) )                                                     & 
     922                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   & 
     923                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     & 
     924                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   & 
    884925                  &                            ) 
    885926 
     
    897938      DO jj = 2, jpjm1 
    898939         DO ji = fs_2, fs_jpim1   ! vector opt. 
     940!!gm            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
    899941            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj) 
    900942            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj) 
     943!!gm            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
    901944            ! add to the general momentum trend 
    902945            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    915958                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    & 
    916959                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) / e1u(ji,jj) 
     960!!gm                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    917961               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                & 
    918962                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    & 
    919963                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) / e2v(ji,jj) 
     964!!gm                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj) 
    920965               ! add to the general momentum trend 
    921966               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    9831028        DO ji = 1, jpi 
    9841029          jk = mbathy(ji,jj) 
    985           IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp 
    986           ELSE IF(jk == 1) THEN; zrhh(ji,jj, jk+1:jpk) = rhd(ji,jj,jk) 
    987           ELSE IF(jk < jpkm1) THEN 
     1030          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
     1031          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
     1032          ELSEIF( jk < jpkm1 ) THEN 
    9881033             DO jkk = jk+1, jpk 
    989                 zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk),   fsde3w(ji,jj,jkk-1), & 
    990                                          fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
     1034                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),  & 
     1035                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
    9911036             END DO 
    9921037          ENDIF 
     
    9971042      DO jj = 1, jpj 
    9981043         DO ji = 1, jpi 
    999             zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
     1044            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad 
    10001045         END DO 
    10011046      END DO 
     
    10041049         DO jj = 1, jpj 
    10051050            DO ji = 1, jpi 
    1006                zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
     1051               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk) 
    10071052            END DO 
    10081053         END DO 
     
    10221067          zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 
    10231068                                         bsp(ji,jj,1),   csp(ji,jj,1), & 
    1024                                          dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1) 
     1069                                         dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1) 
    10251070 
    10261071          ! assuming linear profile across the top half surface layer 
    1027           zhpi(ji,jj,1) =  0.5_wp * fse3w(ji,jj,1) * zrhdt1 
     1072          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1 
    10281073        END DO 
    10291074      END DO 
     
    10551100      DO jj = 2, jpjm1 
    10561101        DO ji = 2, jpim1 
    1057           zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad)  
    1058           zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad) 
     1102          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad)  
     1103          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad) 
    10591104        END DO 
    10601105      END DO 
     
    10631108        DO jj = 2, jpjm1 
    10641109          DO ji = 2, jpim1 
    1065             zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk) 
    1066             zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk) 
     1110            zu(ji,jj,jk) = zu(ji,jj,jk-1)- e3u_n(ji,jj,jk) 
     1111            zv(ji,jj,jk) = zv(ji,jj,jk-1)- e3v_n(ji,jj,jk) 
    10671112          END DO 
    10681113        END DO 
     
    10721117        DO jj = 2, jpjm1 
    10731118          DO ji = 2, jpim1 
    1074             zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk) 
    1075             zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk) 
     1119            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk) 
     1120            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk) 
    10761121          END DO 
    10771122        END DO 
     
    11421187               ! update the momentum trends in u direction 
    11431188 
     1189!!gm               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
    11441190               zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
    11451191               IF( lk_vvl ) THEN 
     1192!!gm                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
    11461193                 zdpdx2 = zcoef0 / e1u(ji,jj) * & 
    11471194                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 
    11481195                ELSE 
     1196!!gm                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    11491197                 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    11501198               ENDIF 
     
    11991247               ! update the momentum trends in v direction 
    12001248 
     1249!!gm               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
    12011250               zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
    12021251               IF( lk_vvl ) THEN 
     1252!!gm                   zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    12031253                   zdpdy2 = zcoef0 / e2v(ji,jj) * & 
    12041254                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
    12051255               ELSE 
     1256!!gm                   zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    12061257                   zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    12071258               ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r5836 r5845  
    4646 
    4747   !! * Substitutions 
    48 #  include "domzgr_substitute.h90" 
    4948#  include "vectopt_loop_substitute.h90" 
    5049   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r5836 r5845  
    4141 
    4242   !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4443#  include "vectopt_loop_substitute.h90" 
    4544   !!---------------------------------------------------------------------- 
     
    135134            DO jj = 2, jpjm1 
    136135               DO ji = 2, jpim1 
    137                   uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    138                   vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    139                   wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    140                   wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     136                  uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     137                  vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     138                  wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     139                  wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    141140               END DO 
    142141            END DO 
     
    183182            DO jj = 2, jpjm1 
    184183               DO ji = fs_2, jpi   ! vector opt. 
    185                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj) 
     184                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) 
    186185 
    187186                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
     
    198197            DO jj = 2, jpjm1 
    199198               DO ji = fs_2, jpi   ! vector opt. 
    200                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj) 
     199                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj) 
    201200 
    202201                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
     
    215214         DO jj = 1, jpjm1 
    216215            DO ji = 1, fs_jpim1   ! vector opt. 
    217                zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj) 
     216               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj) 
    218217 
    219218               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
     
    236235         DO jj = 2, jpjm1 
    237236            DO ji = 1, fs_jpim1   ! vector opt. 
    238                zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj) 
     237               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj) 
    239238 
    240239               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
     
    253252            DO jj = 2, jpj 
    254253               DO ji = 1, fs_jpim1   ! vector opt. 
    255                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj) 
     254                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) 
    256255 
    257256                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
     
    268267            DO jj = 2, jpj 
    269268               DO ji = 1, fs_jpim1   ! vector opt. 
    270                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj) 
     269                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj) 
    271270 
    272271                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
     
    288287            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug 
    289288               ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj  )    & 
    290                   &                          + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     289                  &                          + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    291290               va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj  ) - zivf(ji-1,jj)    & 
    292                   &                          + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     291                  &                          + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    293292            END DO 
    294293         END DO 
     
    403402         DO jk = 1, jpkm1 
    404403            DO ji = 2, jpim1 
    405                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    406                va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     404               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     405               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    407406            END DO 
    408407         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90

    r5836 r5845  
    3535 
    3636   !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3837#  include "vectopt_loop_substitute.h90" 
    3938   !!---------------------------------------------------------------------- 
     
    8786            DO ji = fs_2, jpi   ! vector opt. 
    8887               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    89                zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)      & 
     88               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)      & 
    9089                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)                & 
    9190                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  ) * fmask(ji-1,jj-1,jk) 
    9291               !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    93                zdiv(ji,jj)     = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )                     * tmask(ji,jj,jk)    & 
    94                   &     * (  e2u(ji,jj)*fse3u(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * pub(ji-1,jj,jk)    & 
    95                   &        + e1v(ji,jj)*fse3v(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * pvb(ji,jj-1,jk)  ) 
     92               zdiv(ji,jj)     = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )                     * tmask(ji,jj,jk)    & 
     93                  &     * (  e2u(ji,jj)*e3u_n(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * pub(ji-1,jj,jk)    & 
     94                  &        + e1v(ji,jj)*e3v_n(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_n(ji,jj-1,jk) * pvb(ji,jj-1,jk)  ) 
    9695            END DO   
    9796         END DO   
     
    10099            DO ji = fs_2, fs_jpim1   ! vector opt. 
    101100               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                   & 
    102                   &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) /  ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     101                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) /  ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   & 
    103102                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
    104103                  ! 
    105104               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                   & 
    106                   &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) /  ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     105                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) /  ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
    107106                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
    108107            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r5643 r5845  
    5555   PUBLIC    dyn_nxt   ! routine called by step.F90 
    5656 
    57    !! * Substitutions 
    58 #  include "domzgr_substitute.h90" 
    5957   !!---------------------------------------------------------------------- 
    6058   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    146144      ELSE                                            ! applied on thickness weighted velocity 
    147145         DO jk = 1, jpkm1 
    148             ua(:,:,jk) = (          ub(:,:,jk) * fse3u_b(:,:,jk)      & 
    149                &           + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk)  )   & 
    150                &         / fse3u_a(:,:,jk) * umask(:,:,jk) 
    151             va(:,:,jk) = (          vb(:,:,jk) * fse3v_b(:,:,jk)      & 
    152                &           + z2dt * va(:,:,jk) * fse3v_n(:,:,jk)  )   & 
    153                &         / fse3v_a(:,:,jk) * vmask(:,:,jk) 
     146            ua(:,:,jk) = (          ub(:,:,jk) * e3u_b(:,:,jk)    & 
     147               &           + z2dt * ua(:,:,jk) * e3u_n(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     148            va(:,:,jk) = (          vb(:,:,jk) * e3v_b(:,:,jk)    & 
     149               &           + z2dt * va(:,:,jk) * e3v_n(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    154150         END DO 
    155151      ENDIF 
     
    160156      ! Ensure below that barotropic velocities match time splitting estimate 
    161157      ! Compute actual transport and replace it with ts estimate at "after" time step 
    162       zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    163       zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     158      zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
     159      zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
    164160      DO jk = 2, jpkm1 
    165          zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    166          zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     161         zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     162         zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    167163      END DO 
    168164      DO jk = 1, jpkm1 
    169          ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    170          va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
     165         ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
     166         va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    171167      END DO 
    172168 
     
    231227         IF (lk_vvl) THEN 
    232228            DO jk = 1, jpkm1 
    233                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
    234                fse3u_b(:,:,jk) = fse3u_n(:,:,jk) 
    235                fse3v_b(:,:,jk) = fse3v_n(:,:,jk) 
     229               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     230               e3u_b(:,:,jk) = e3u_n(:,:,jk) 
     231               e3v_b(:,:,jk) = e3v_n(:,:,jk) 
    236232            ENDDO 
    237233         ENDIF 
     
    261257            IF (lk_dynspg_ts.AND.ln_bt_fw) THEN 
    262258               ! No asselin filtering on thicknesses if forward time splitting 
    263                   fse3t_b(:,:,:) = fse3t_n(:,:,:) 
     259                  e3t_b(:,:,:) = e3t_n(:,:,:) 
    264260            ELSE 
    265                fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * ( fse3t_b(:,:,:) - 2._wp * fse3t_n(:,:,:) + fse3t_a(:,:,:) ) 
     261               e3t_b(:,:,:) = e3t_n(:,:,:) + atfp * ( e3t_b(:,:,:) - 2._wp * e3t_n(:,:,:) + e3t_a(:,:,:) ) 
    266262               ! Add volume filter correction: compatibility with tracer advection scheme 
    267263               ! => time filter + conservation correction (only at the first level) 
    268264               IF ( nn_isf == 0) THEN   ! if no ice shelf melting 
    269                   fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 
     265                  e3t_b(:,:,1) = e3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 
    270266                                 &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    271267               ELSE                     ! if ice shelf melting 
     
    273269                     DO ji = 1,jpi 
    274270                        jk = mikt(ji,jj) 
    275                         fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       & 
    276                                           &                          * ( (emp_b(ji,jj)    - emp(ji,jj)   ) & 
    277                                           &                            - (rnf_b(ji,jj)    - rnf(ji,jj)   ) & 
    278                                           &                            + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 
     271                        e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       & 
     272                                          &                      * ( (emp_b(ji,jj)    - emp(ji,jj)   ) & 
     273                                          &                        - (rnf_b(ji,jj)    - rnf(ji,jj)   ) & 
     274                                          &                        + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 
    279275                     END DO 
    280276                  END DO 
     
    285281               ! Before scale factor at (u/v)-points 
    286282               ! ----------------------------------- 
    287                CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
    288                CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
     283               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
     284               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
    289285               ! Leap-Frog - Asselin filter and swap: applied on velocity 
    290286               ! ----------------------------------- 
     
    306302               ! Temporary filtered scale factor at (u/v)-points (will become before scale factor) 
    307303               !------------------------------------------------ 
    308                CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3u_f, 'U' ) 
    309                CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3v_f, 'V' ) 
     304               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
     305               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
    310306               ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 
    311307               ! -----------------------------------             =========================== 
     
    313309                  DO jj = 1, jpj 
    314310                     DO ji = 1, jpi                   
    315                         zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 
    316                         zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 
    317                         zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk) 
    318                         zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk) 
    319                         zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 
    320                         zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 
     311                        zue3a = ua(ji,jj,jk) * e3u_a(ji,jj,jk) 
     312                        zve3a = va(ji,jj,jk) * e3v_a(ji,jj,jk) 
     313                        zue3n = un(ji,jj,jk) * e3u_n(ji,jj,jk) 
     314                        zve3n = vn(ji,jj,jk) * e3v_n(ji,jj,jk) 
     315                        zue3b = ub(ji,jj,jk) * e3u_b(ji,jj,jk) 
     316                        zve3b = vb(ji,jj,jk) * e3v_b(ji,jj,jk) 
    321317                        ! 
    322318                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
     
    330326                  END DO 
    331327               END DO 
    332                fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
    333                fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     328               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
     329               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
    334330            ENDIF 
    335331            ! 
     
    339335            ! Revert "before" velocities to time split estimate 
    340336            ! Doing it here also means that asselin filter contribution is removed   
    341             zue(:,:) = fse3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    342             zve(:,:) = fse3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     337            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
     338            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
    343339            DO jk = 2, jpkm1 
    344                zue(:,:) = zue(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    345                zve(:,:) = zve(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
     340               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
     341               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    346342            END DO 
    347343            DO jk = 1, jpkm1 
    348                ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) 
    349                vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
     344               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
     345               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
    350346            END DO 
    351347         ENDIF 
     
    359355      ! 
    360356      IF (lk_vvl) THEN 
    361          hu_b(:,:) = 0. 
    362          hv_b(:,:) = 0. 
    363          DO jk = 1, jpkm1 
    364             hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 
    365             hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
     357         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
     358         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     359         DO jk = 2, jpkm1 
     360            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
     361            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    366362         END DO 
    367          hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 
    368          hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
    369       ENDIF 
    370       ! 
    371       un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 
    372       ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 
    373       ! 
     363!!gm don't understand the use of umask_i .... 
     364         r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 
     365         r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
     366      ENDIF 
     367      ! 
     368      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
     369      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    374370      DO jk = 1, jpkm1 
    375371         DO jj = 1, jpj 
    376372            DO ji = 1, jpi 
    377                un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    378                vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     373               un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     374               vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    379375               ! 
    380                ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    381                vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     376               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     377               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    382378            END DO 
    383379         END DO 
    384380      END DO 
    385       ! 
    386       ! 
    387       un_b(:,:) = un_b(:,:) * hur_a(:,:) 
    388       vn_b(:,:) = vn_b(:,:) * hvr_a(:,:) 
    389       ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 
    390       vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 
    391       ! 
    392       ! 
    393  
     381      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
     382      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
     383      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
     384      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     385      ! 
    394386      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    395387         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r5836 r5845  
    4646 
    4747   !! * Substitutions 
    48 #  include "domzgr_substitute.h90" 
    4948#  include "vectopt_loop_substitute.h90" 
    5049   !!---------------------------------------------------------------------- 
     
    7877      !!             period is used to prevent the divergence of odd and even time step. 
    7978      !!---------------------------------------------------------------------- 
    80       ! 
    8179      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    8280      INTEGER, INTENT(  out) ::   kindic   ! solver flag 
     
    9795 
    9896      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    99          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     97         CALL wrk_alloc( jpi,jpj,jpk,  ztrdu, ztrdv )  
    10098         ztrdu(:,:,:) = ua(:,:,:) 
    10199         ztrdv(:,:,:) = va(:,:,:) 
     
    139137         ! 
    140138         IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
    141             CALL wrk_alloc( jpi, jpj, zpice ) 
     139            CALL wrk_alloc( jpi,jpj,  zpice ) 
    142140            !                                             
    143141            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
     
    151149            END DO 
    152150            ! 
    153             CALL wrk_dealloc( jpi, jpj, zpice )          
     151            CALL wrk_dealloc( jpi,jpj,  zpice )          
    154152         ENDIF 
    155153         ! 
     
    188186         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    189187         ! 
    190          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     188         CALL wrk_dealloc( jpi,jpj,jpk,  ztrdu, ztrdv )  
    191189      ENDIF 
    192190      !                                          ! print mean trends (used for debugging) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r5836 r5845  
    3434 
    3535   !! * Substitutions 
    36 #  include "domzgr_substitute.h90" 
    3736#  include "vectopt_loop_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
     
    8180         DO jj = 2, jpjm1                    ! now surface pressure gradient 
    8281            DO ji = fs_2, fs_jpim1   ! vector opt. 
    83                spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj) 
    84                spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
     82               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
     83               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    8584            END DO  
    8685         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r5836 r5845  
    5959 
    6060   !! * Substitutions 
    61 #  include "domzgr_substitute.h90" 
    6261#  include "vectopt_loop_substitute.h90" 
    6362   !!---------------------------------------------------------------------- 
     
    155154               DO jj = 2, jpjm1 
    156155                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    157                      ua(ji,jj,jk) = (        ub(ji,jj,jk) * fse3u_b(ji,jj,jk)      & 
    158                         &           + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk)  )   & 
    159                         &         / fse3u_a(ji,jj,jk) * umask(ji,jj,jk) 
    160                      va(ji,jj,jk) = (        vb(ji,jj,jk) * fse3v_b(ji,jj,jk)      & 
    161                         &           + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk)  )   & 
    162                         &         / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
     156                     ua(ji,jj,jk) = (        ub(ji,jj,jk) * e3u_b(ji,jj,jk)    & 
     157                        &           + z2dt * ua(ji,jj,jk) * e3u_n(ji,jj,jk)  ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 
     158                     va(ji,jj,jk) = (        vb(ji,jj,jk) * e3v_b(ji,jj,jk)    & 
     159                        &           + z2dt * va(ji,jj,jk) * e3v_n(ji,jj,jk)  ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
    163160                 END DO 
    164161               END DO 
     
    171168         DO jj = 2, jpjm1              ! Surface pressure gradient (now) 
    172169            DO ji = fs_2, fs_jpim1   ! vector opt. 
    173                spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj) 
    174                spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
     170               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
     171               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    175172            END DO  
    176173         END DO  
     
    211208      DO jj = 2, jpjm1 
    212209         DO ji = fs_2, fs_jpim1   ! vector opt. 
    213             spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1) 
    214             spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1) 
     210            spgu(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) 
     211            spgv(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) 
    215212         END DO 
    216213      END DO 
     
    218215         DO jj = 2, jpjm1 
    219216            DO ji = fs_2, fs_jpim1   ! vector opt. 
    220                spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 
    221                spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 
     217               spgu(ji,jj) = spgu(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) 
     218               spgv(ji,jj) = spgv(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) 
    222219            END DO 
    223220         END DO 
     
    256253         ! add contribution of gradient of after barotropic transport divergence  
    257254         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =   & 
    258             &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:) 
     255            &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu_n(2     ,:) * e2u(2     ,:) 
    259256         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =   & 
    260             &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:) 
     257            &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu_n(nlci-2,:) * e2u(nlci-2,:) 
    261258         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =   & 
    262             &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     ) 
     259            &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv_n(:,2     ) * e1v(:,2     ) 
    263260         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =   & 
    264             &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2) 
     261            &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv_n(:,nlcj-2) * e1v(:,nlcj-2) 
    265262      ENDIF 
    266263#endif 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5836 r5845  
    7575 
    7676   !! * Substitutions 
    77 #  include "domzgr_substitute.h90" 
    7877#  include "vectopt_loop_substitute.h90" 
    7978   !!---------------------------------------------------------------------- 
     
    9190      !!---------------------------------------------------------------------- 
    9291      ierr(:) = 0 
    93  
     92      ! 
    9493      ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
    9594         &      ub_e(jpi,jpj)  , vb_e(jpi,jpj)   , & 
    9695         &      ubb_e(jpi,jpj) , vbb_e(jpi,jpj)  , STAT= ierr(1) ) 
    97  
     96         ! 
    9897      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 
    99  
     98      ! 
    10099      IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &  
    101100         &                          ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 
    102  
    103       dyn_spg_ts_alloc = MAXVAL(ierr(:)) 
    104  
     101      ! 
     102      dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 
    105103      IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc ) 
    106104      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays') 
     
    138136      !!              Ocean Modelling, 9, 347-404.  
    139137      !!--------------------------------------------------------------------- 
    140       ! 
    141138      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    142139      ! 
    143       LOGICAL  ::   ll_fw_start        ! if true, forward integration  
    144       LOGICAL  ::   ll_init             ! if true, special startup of 2d equations 
    145       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
    146       INTEGER  ::   ikbu, ikbv, noffset      ! local integers 
    147       REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf    ! local scalars 
     140      LOGICAL  ::   ll_fw_start      ! if true, forward integration  
     141      LOGICAL  ::   ll_init          ! if true, special startup of 2d equations 
     142      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     143      INTEGER  ::   ikbu, ikbv, noffset        ! local integers 
     144      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf   ! local scalars 
    148145      REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      - 
    149146      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2    !   -      - 
    150147      REAL(wp) ::   zu_spg, zv_spg             !   -      - 
    151148      REAL(wp) ::   zhura, zhvra               !   -      - 
    152       REAL(wp) ::   za0, za1, za2, za3           !   -      - 
    153       ! 
    154       REAL(wp), POINTER, DIMENSION(:,:) :: zun_e, zvn_e, zsshp2_e 
    155       REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 
    156       REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv 
    157       REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 
    158       REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 
    159       REAL(wp), POINTER, DIMENSION(:,:) :: zhf 
     149      REAL(wp) ::   za0, za1, za2, za3         !   -      - 
     150      ! 
     151      REAL(wp), POINTER, DIMENSION(:,:) ::   zun_e, zvn_e, zsshp2_e 
     152      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 
     153      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_sum, zv_sum, zwx, zwy, zhdiv 
     154      REAL(wp), POINTER, DIMENSION(:,:) ::   zhup2_e, zhvp2_e, zhust_e, zhvst_e 
     155      REAL(wp), POINTER, DIMENSION(:,:) ::   zsshu_a, zsshv_a 
     156      REAL(wp), POINTER, DIMENSION(:,:) ::   zhf 
    160157      !!---------------------------------------------------------------------- 
    161158      ! 
    162159      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts') 
    163160      ! 
    164       !                                         !* Allocate temporary arrays 
    165       CALL wrk_alloc( jpi, jpj, zsshp2_e, zhdiv ) 
    166       CALL wrk_alloc( jpi, jpj, zu_trd, zv_trd, zun_e, zvn_e  ) 
    167       CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 
    168       CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 
    169       CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a                                   ) 
    170       CALL wrk_alloc( jpi, jpj, zhf ) 
    171       ! 
    172       !                                         !* Local constant initialization 
    173       z1_12 = 1._wp / 12._wp  
     161      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv ) 
     162      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd, zun_e, zvn_e  ) 
     163      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 
     164      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e) 
     165      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a ) 
     166      CALL wrk_alloc( jpi,jpj,   zhf ) 
     167      ! 
     168      z1_12 = 1._wp / 12._wp                 !* Local constant initialization 
    174169      z1_8  = 0.125_wp                                    
    175170      z1_4  = 0.25_wp 
    176171      z1_2  = 0.5_wp      
    177172      zraur = 1._wp / rau0 
    178       ! 
    179       IF( kt == nit000 .AND. neuler == 0 ) THEN    ! reciprocal of baroclinic time step  
    180         z2dt_bf = rdt 
    181       ELSE 
    182         z2dt_bf = 2.0_wp * rdt 
     173      !                                            ! reciprocal of baroclinic time step  
     174      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt 
     175      ELSE                                        ;   z2dt_bf = 2.0_wp * rdt 
    183176      ENDIF 
    184177      z1_2dt_b = 1.0_wp / z2dt_bf  
    185178      ! 
    186       ll_init = ln_bt_av                           ! if no time averaging, then no specific restart  
     179      ll_init     = ln_bt_av                       ! if no time averaging, then no specific restart  
    187180      ll_fw_start = .FALSE. 
    188       ! 
    189                                                        ! time offset in steps for bdy data update 
    190       IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ;  noffset = 0 ; ENDIF 
     181      !                                            ! time offset in steps for bdy data update 
     182      IF( .NOT.ln_bt_fw ) THEN   ;   noffset =-2*nn_baro 
     183      ELSE                       ;   noffset = 0  
     184      ENDIF 
    191185      ! 
    192186      IF( kt == nit000 ) THEN                !* initialisation 
     
    197191         IF(lwp) WRITE(numout,*) 
    198192         ! 
    199          IF (neuler==0) ll_init=.TRUE. 
    200          ! 
    201          IF (ln_bt_fw.OR.(neuler==0)) THEN 
    202            ll_fw_start=.TRUE. 
    203            noffset = 0 
     193         IF( neuler == 0 )  ll_init=.TRUE. 
     194         ! 
     195         IF( ln_bt_fw .OR. neuler == 0 ) THEN 
     196            ll_fw_start=.TRUE. 
     197            noffset = 0 
    204198         ELSE 
    205            ll_fw_start=.FALSE. 
     199            ll_fw_start=.FALSE. 
    206200         ENDIF 
    207201         ! 
    208202         ! Set averaging weights and cycle length: 
    209          CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 
    210          ! 
     203         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 
    211204         ! 
    212205      ENDIF 
     
    225218               DO jj = 1, jpjm1 
    226219                  DO ji = 1, jpim1 
    227                      zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
    228                         &             ht(ji  ,jj  ) + ht(ji+1,jj  )   ) / 4._wp   
     220                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
     221                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) / 4._wp   
    229222                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 
    230223                  END DO 
     
    233226               DO jj = 1, jpjm1 
    234227                  DO ji = 1, jpim1 
    235                      zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                     & 
    236                         &             ht(ji  ,jj  ) + ht(ji+1,jj  )   )                   & 
     228                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                     & 
     229                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   )                   & 
    237230                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    & 
    238231                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) ) 
     
    276269            DO jk = 1, jpkm1 
    277270               DO jj = 1, jpjm1 
    278                   zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
     271                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
    279272               END DO 
    280273            END DO 
     
    308301      ! 
    309302      DO jk = 1, jpkm1 
    310          zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    311          zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
     303         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     304         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
    312305      END DO 
    313306      ! 
    314       zu_frc(:,:) = zu_frc(:,:) * hur(:,:) 
    315       zv_frc(:,:) = zv_frc(:,:) * hvr(:,:) 
     307      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
     308      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
    316309      ! 
    317310      ! 
     
    327320      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    328321      !                                   ! -------------------------------------------------------- 
    329       zwx(:,:) = un_b(:,:) * hu(:,:) * e2u(:,:)        ! now fluxes  
    330       zwy(:,:) = vn_b(:,:) * hv(:,:) * e1v(:,:) 
     322      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
     323      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 
    331324      ! 
    332325      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme 
     
    411404      ! 
    412405      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 
    413       zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:) 
    414       zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:) 
     406      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 
     407      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 
    415408      !        
    416409      IF (ln_bt_fw) THEN                        ! Add wind forcing 
    417          zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * hur(:,:) 
    418          zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * hvr(:,:) 
     410         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
     411         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
    419412      ELSE 
    420          zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:) 
    421          zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:) 
     413         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 
     414         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 
    422415      ENDIF   
    423416      ! 
     
    484477      ! 
    485478      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    486          sshn_e(:,:) = sshn (:,:)             
    487          zun_e (:,:) = un_b (:,:)             
    488          zvn_e (:,:) = vn_b (:,:) 
    489          ! 
    490          hu_e  (:,:) = hu   (:,:)        
    491          hv_e  (:,:) = hv   (:,:)  
    492          hur_e (:,:) = hur  (:,:)     
    493          hvr_e (:,:) = hvr  (:,:) 
     479         sshn_e(:,:) = sshn(:,:)             
     480         zun_e (:,:) = un_b(:,:)             
     481         zvn_e (:,:) = vn_b(:,:) 
     482         ! 
     483         hu_e  (:,:) =    hu_n(:,:)        
     484         hv_e  (:,:) =    hv_n(:,:)  
     485         hur_e (:,:) = r1_hu_n(:,:)     
     486         hvr_e (:,:) = r1_hv_n(:,:) 
    494487      ELSE                                ! CENTRED integration: start from BEFORE fields 
    495          sshn_e(:,:) = sshb (:,:) 
    496          zun_e (:,:) = ub_b (:,:)          
    497          zvn_e (:,:) = vb_b (:,:) 
    498          ! 
    499          hu_e  (:,:) = hu_b (:,:)        
    500          hv_e  (:,:) = hv_b (:,:)  
    501          hur_e (:,:) = hur_b(:,:)     
    502          hvr_e (:,:) = hvr_b(:,:) 
     488         sshn_e(:,:) = sshb(:,:) 
     489         zun_e (:,:) = ub_b(:,:)          
     490         zvn_e (:,:) = vb_b(:,:) 
     491         ! 
     492         hu_e  (:,:) =    hu_b(:,:)        
     493         hv_e  (:,:) =    hv_b(:,:)  
     494         hur_e (:,:) = r1_hu_b(:,:)     
     495         hvr_e (:,:) = r1_hv_b(:,:) 
    503496      ENDIF 
    504497      ! 
     
    519512#if defined key_tide 
    520513         IF ( lk_bdy .AND. lk_tide )      CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 
    521          IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, koffset=noffset ) 
     514         IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide     ( kt, kit=jn, koffset=noffset ) 
    522515#endif 
    523516         ! 
     
    557550            zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 
    558551         ELSE 
    559             zhup2_e (:,:) = hu(:,:) 
    560             zhvp2_e (:,:) = hv(:,:) 
     552            zhup2_e (:,:) = hu_n(:,:) 
     553            zhvp2_e (:,:) = hv_n(:,:) 
    561554         ENDIF 
    562555         !                                                !* after ssh 
     
    775768                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
    776769                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
    777                             &               +      hu(ji,jj)  * zu_frc(ji,jj) ) & 
     770                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) & 
    778771                            &   ) * zhura 
    779772 
     
    781774                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
    782775                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
    783                             &               +      hv(ji,jj)  * zv_frc(ji,jj) ) & 
     776                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) & 
    784777                            &   ) * zhvra 
    785778               END DO 
     
    857850      ! 
    858851      ! Set advection velocity correction: 
    859       IF (((kt==nit000).AND.(neuler==0)).OR.(.NOT.ln_bt_fw)) THEN      
    860          un_adv(:,:) = zu_sum(:,:)*hur(:,:) 
    861          vn_adv(:,:) = zv_sum(:,:)*hvr(:,:) 
     852      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
     853         un_adv(:,:) = zu_sum(:,:) * r1_hu_n(:,:) 
     854         vn_adv(:,:) = zv_sum(:,:) * r1_hv_n(:,:) 
    862855      ELSE 
    863          un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:)) * hur(:,:) 
    864          vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:)) * hvr(:,:) 
     856         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:) ) * r1_hu_n(:,:) 
     857         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:) ) * r1_hv_n(:,:) 
    865858      END IF 
    866859 
    867       IF (ln_bt_fw) THEN ! Save integrated transport for next computation 
     860      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
    868861         ub2_b(:,:) = zu_sum(:,:) 
    869862         vb2_b(:,:) = zv_sum(:,:) 
     
    871864      ! 
    872865      ! Update barotropic trend: 
    873       IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN 
     866      IF( ln_dynadv_vec .OR. .NOT.lk_vvl ) THEN 
    874867         DO jk=1,jpkm1 
    875868            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
     
    878871      ELSE 
    879872         DO jk=1,jpkm1 
    880             ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
    881             va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 
     873            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
     874            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 
    882875         END DO 
    883876         ! Save barotropic velocities not transport: 
    884          ua_b  (:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) ) 
    885          va_b  (:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
     877         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) ) 
     878         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
    886879      ENDIF 
    887880      ! 
    888881      DO jk = 1, jpkm1 
    889882         ! Correct velocities: 
    890          un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) )*umask(:,:,jk) 
    891          vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) )*vmask(:,:,jk) 
     883         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 
     884         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
    892885         ! 
    893886      END DO 
     
    897890      ! (used to update coarse grid transports at next time step) 
    898891      ! 
    899       IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN 
    900          IF ( Agrif_NbStepint().EQ.0 ) THEN 
    901             ub2_i_b(:,:) = 0.e0 
    902             vb2_i_b(:,:) = 0.e0 
     892      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 
     893         IF( Agrif_NbStepint() == 0 ) THEN 
     894            ub2_i_b(:,:) = 0._wp 
     895            vb2_i_b(:,:) = 0._wp 
    903896         END IF 
    904897         ! 
     
    912905      ! 
    913906      !                                   !* write time-spliting arrays in the restart 
    914       IF(lrst_oce .AND.ln_bt_fw)   CALL ts_rst( kt, 'WRITE' ) 
    915       ! 
    916       CALL wrk_dealloc( jpi, jpj, zsshp2_e, zhdiv ) 
    917       CALL wrk_dealloc( jpi, jpj, zu_trd, zv_trd, zun_e, zvn_e ) 
    918       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 
    919       CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 
    920       CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a                                  ) 
    921       CALL wrk_dealloc( jpi, jpj, zhf ) 
     907      IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' ) 
     908      ! 
     909      CALL wrk_dealloc( jpi,jpj,  zsshp2_e, zhdiv ) 
     910      CALL wrk_dealloc( jpi,jpj,  zu_trd, zv_trd, zun_e, zvn_e ) 
     911      CALL wrk_dealloc( jpi,jpj,  zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 
     912      CALL wrk_dealloc( jpi,jpj,  zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 
     913      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a ) 
     914      CALL wrk_dealloc( jpi,jpj,  zhf ) 
    922915      ! 
    923916      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
    924917      ! 
    925918   END SUBROUTINE dyn_spg_ts 
     919 
    926920 
    927921   SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 
     
    10941088         END DO 
    10951089      ELSE 
     1090!!gm  BUG ??  restartability issue if ssh changes are large.... 
     1091!!gm          We should just test this with ht_0 only, no? 
    10961092         DO jj = 1, jpj 
    10971093            DO ji =1, jpi 
    10981094               zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    10991095               zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    1100                zcu(ji,jj) = SQRT( grav * ht(ji,jj) * (zxr2 + zyr2) ) 
     1096               zcu(ji,jj) = SQRT( grav * ht_n(ji,jj) * (zxr2 + zyr2) ) 
    11011097            END DO 
    11021098         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5836 r5845  
    7575    
    7676   !! * Substitutions 
    77 #  include "domzgr_substitute.h90" 
    7877#  include "vectopt_loop_substitute.h90" 
    7978   !!---------------------------------------------------------------------- 
     
    284283 
    285284         IF( ln_sco ) THEN 
    286             zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
    287             zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    288             zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     285            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
     286            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     287            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    289288         ELSE 
    290289            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
     
    404403         ! 
    405404         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
    406             zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
    407             zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    408             zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     405            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
     406            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     407            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    409408         ELSE 
    410409            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
     
    415414            DO ji = fs_2, fs_jpim1   ! vector opt. 
    416415               zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    417                   &                       + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     416                  &                          + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    418417               zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    419                   &                       + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
     418                  &                          + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    420419               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    421420               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    482481            DO jj = 1, jpjm1 
    483482               DO ji = 1, fs_jpim1   ! vector opt. 
    484                   ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    485                      &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     483                  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)   & 
     484                     &   + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    486485                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4.0_wp / ze3 
    487486                  ELSE                      ;   z1_e3f(ji,jj) = 0.0_wp 
     
    492491            DO jj = 1, jpjm1 
    493492               DO ji = 1, fs_jpim1   ! vector opt. 
    494                   ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    495                      &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     493                  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)   & 
     494                     &   + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    496495                  zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    497496                     &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
     
    558557         ! 
    559558         !                                   !==  horizontal fluxes  ==! 
    560          zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    561          zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     559         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     560         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    562561 
    563562         !                                   !==  compute and add the vorticity term trend  =! 
     
    633632         WRITE(numout,*) '           enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een 
    634633         WRITE(numout,*) '              e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
    635          WRITE(numout,*) '           masked (=1) or unmasked(=0) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
     634         WRITE(numout,*) '           masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
    636635      ENDIF 
    637636 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r5836 r5845  
    3232 
    3333   !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3534#  include "vectopt_loop_substitute.h90" 
    3635   !!---------------------------------------------------------------------- 
     
    121120            DO ji = fs_2, fs_jpim1       ! vector opt. 
    122121               !                         ! vertical momentum advective trends 
    123                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    124                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     122               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     123               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    125124               !                         ! add the trends to the general momentum trends 
    126125               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     
    252251               DO ji = fs_2, fs_jpim1       ! vector opt. 
    253252                  !                         ! vertical momentum advective trends 
    254                   zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    255                   zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     253                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     254                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    256255                  zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 
    257256                  zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r5836 r5845  
    3737 
    3838   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    40 #  include "zdfddm_substitute.h90" 
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r3625 r5845  
    3232    
    3333   !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3534#  include "vectopt_loop_substitute.h90" 
    3635   !!---------------------------------------------------------------------- 
     
    9897            DO jj = 2, jpjm1  
    9998               DO ji = 2, jpim1 
    100                   zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / fse3uw(ji,jj,jk)  
    101                   zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(ji,jj,jk) 
     99                  zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / e3uw_n(ji,jj,jk)  
     100                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / e3vw_n(ji,jj,jk) 
    102101               END DO   
    103102            END DO   
     
    106105            DO jj = 2, jpjm1  
    107106               DO ji = 2, jpim1 
    108                   zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / fse3u(ji,jj,jk) 
    109                   zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk) 
     107                  zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 
     108                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 
    110109                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    111110                  va(ji,jj,jk) = va(ji,jj,jk) + zva 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r5836 r5845  
    3636 
    3737   !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
     
    103102               ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points  
    104103               ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    105                avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 
    106                avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 
     104               avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * e3uw_n(ji,jj,ikbu+1) 
     105               avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * e3vw_n(ji,jj,ikbv+1) 
    107106            END DO 
    108107         END DO 
     
    112111                  ikbu = miku(ji,jj)       ! ocean top level at u- and v-points  
    113112                  ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    114                   IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu) 
    115                   IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv) 
     113                  IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu) 
     114                  IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv) 
    116115               END DO 
    117116            END DO 
     
    127126      ELSE                                            ! applied on thickness weighted velocity 
    128127         DO jk = 1, jpkm1 
    129             ua(:,:,jk) = (          ub(:,:,jk) * fse3u_b(:,:,jk)      & 
    130                &           + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk)  )   & 
    131                &                               / fse3u_a(:,:,jk) * umask(:,:,jk) 
    132             va(:,:,jk) = (          vb(:,:,jk) * fse3v_b(:,:,jk)      & 
    133                &           + p2dt * va(:,:,jk) * fse3v_n(:,:,jk)  )   & 
    134                &                               / fse3v_a(:,:,jk) * vmask(:,:,jk) 
     128            ua(:,:,jk) = (          ub(:,:,jk) * e3u_b(:,:,jk)      & 
     129               &           + p2dt * ua(:,:,jk) * e3u_n(:,:,jk)  )   & 
     130               &                               / e3u_a(:,:,jk) * umask(:,:,jk) 
     131            va(:,:,jk) = (          vb(:,:,jk) * e3v_b(:,:,jk)      & 
     132               &           + p2dt * va(:,:,jk) * e3v_n(:,:,jk)  )   & 
     133               &                               / e3v_a(:,:,jk) * vmask(:,:,jk) 
    135134         END DO 
    136135      ENDIF 
     
    147146               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    148147               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    149                ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu) 
    150                ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv) 
     148               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl   * e3u_a(ji,jj,ikbu) 
     149               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl   * e3v_a(ji,jj,ikbv) 
    151150               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 
    152151               va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va 
     
    158157                  ikbu = miku(ji,jj)         ! top ocean level at u- and v-points  
    159158                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    160                   ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu) 
    161                   ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv) 
     159                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl   * e3u_a(ji,jj,ikbu) 
     160                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl   * e3v_a(ji,jj,ikbv) 
    162161                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 
    163162                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va 
     
    177176         DO jj = 2, jpjm1  
    178177            DO ji = fs_2, fs_jpim1   ! vector opt. 
    179                ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl   * fse3u_a(ji,jj,jk)   ! after scale factor at T-point 
     178               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl   * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    180179               zcoef = - p2dt / ze3ua       
    181                zzwi          = zcoef * avmu  (ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
     180               zzwi          = zcoef * avmu  (ji,jj,jk  ) / e3uw_n(ji,jj,jk  ) 
    182181               zwi(ji,jj,jk) = zzwi  * wumask(ji,jj,jk  ) 
    183                zzws          = zcoef * avmu  (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)  
     182               zzws          = zcoef * avmu  (ji,jj,jk+1) / e3uw_n(ji,jj,jk+1)  
    184183               zws(ji,jj,jk) = zzws  * wumask(ji,jj,jk+1) 
    185184               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
     
    220219         DO ji = fs_2, fs_jpim1   ! vector opt. 
    221220#if defined key_dynspg_ts 
    222             ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl   * fse3u_a(ji,jj,1)  
     221            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl   * e3u_a(ji,jj,1)  
    223222            ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    224223               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
     
    226225            ua(ji,jj,1) = ub(ji,jj,1) & 
    227226               &                   + p2dt *(ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    228                &                                      / ( fse3u(ji,jj,1) * rau0     ) * umask(ji,jj,1) )  
     227               &                                      / ( e3u_n(ji,jj,1) * rau0     ) * umask(ji,jj,1) )  
    229228#endif 
    230229         END DO 
     
    276275         DO jj = 2, jpjm1    
    277276            DO ji = fs_2, fs_jpim1   ! vector opt. 
    278                ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,jk)  + r_vvl * fse3v_a(ji,jj,jk)   ! after scale factor at T-point 
     277               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk)  + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    279278               zcoef = - p2dt / ze3va 
    280                zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
     279               zzwi          = zcoef * avmv (ji,jj,jk  ) / e3vw_n(ji,jj,jk  ) 
    281280               zwi(ji,jj,jk) =  zzwi * wvmask(ji,jj,jk) 
    282                zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
     281               zzws          = zcoef * avmv (ji,jj,jk+1) / e3vw_n(ji,jj,jk+1) 
    283282               zws(ji,jj,jk) =  zzws * wvmask(ji,jj,jk+1) 
    284283               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
     
    319318         DO ji = fs_2, fs_jpim1   ! vector opt. 
    320319#if defined key_dynspg_ts             
    321             ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl   * fse3v_a(ji,jj,1)  
     320            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl   * e3v_a(ji,jj,1)  
    322321            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    323322               &                                      / ( ze3va * rau0 )  
     
    325324            va(ji,jj,1) = vb(ji,jj,1) & 
    326325               &                   + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    327                &                                                       / ( fse3v(ji,jj,1) * rau0     )  ) 
     326               &                                                       / ( e3v_n(ji,jj,1) * rau0     )  ) 
    328327#endif 
    329328         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5836 r5845  
    4747 
    4848   !! * Substitutions 
    49 #  include "domzgr_substitute.h90" 
    5049#  include "vectopt_loop_substitute.h90" 
    5150   !!---------------------------------------------------------------------- 
     
    9796      zhdiv(:,:) = 0._wp 
    9897      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    99         zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk) 
     98        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
    10099      END DO 
    101100      !                                                ! Sea surface elevation time stepping 
     
    194193         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    195194            ! computation of w 
    196             wn(:,:,jk) = wn(:,:,jk+1) - (   fse3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)                    & 
    197                &                          + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
     195            wn(:,:,jk) = wn(:,:,jk+1) - (   e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)                    & 
     196               &                          + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
    198197         END DO 
    199198         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
     
    202201         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    203202            ! computation of w 
    204             wn(:,:,jk) = wn(:,:,jk+1) - (   fse3t_n(:,:,jk) * hdivn(:,:,jk)                                   & 
    205                &                          + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
     203            wn(:,:,jk) = wn(:,:,jk+1) - (   e3t_n(:,:,jk) * hdivn(:,:,jk)                                   & 
     204               &                          + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
    206205         END DO 
    207206      ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90

    r5836 r5845  
    2929   REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           ! 
    3030 
    31    !! * Substitutions 
    32 #  include "domzgr_substitute.h90" 
    3331   !!---------------------------------------------------------------------- 
    3432   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    436434                     &   ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   & 
    437435                     &     tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  & 
    438                      &   / fse3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) 
     436                     &   / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) 
    439437               END DO 
    440438            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r5836 r5845  
    2323   PUBLIC   flo_blk    ! routine called by floats.F90 
    2424 
    25    !! * Substitutions 
    26 #  include "domzgr_substitute.h90" 
    2725   !!---------------------------------------------------------------------- 
    2826   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    118116             
    119117            ! compute the transport across the mesh where the float is.             
    120 !!bug (gm) change e3t into fse3. but never checked  
    121             zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * fse3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl)) 
    122             zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * fse3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
    123             zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * fse3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl)) 
    124             zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * fse3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
     118!!bug (gm) change e3t into e3. but never checked  
     119            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u_n(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl)) 
     120            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
     121            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v_n(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl)) 
     122            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
    125123 
    126124            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 
    127125            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl)) 
    128             zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 
     126            zvol   = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 
    129127 
    130128            ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r5836 r5845  
    3737   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zgifl, zgjfl,  zgkfl      ! distances in indexes 
    3838 
    39    !! * Substitutions 
    40 #  include "domzgr_substitute.h90" 
    4139   !!---------------------------------------------------------------------- 
    4240   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    176174                  ihtest(jfl) = ihtest(jfl)+1 
    177175                  DO jk = 1, jpk-1 
    178                      IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 
     176                     IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN 
    179177                        ikmfl(jfl) = jk 
    180178                        ivtest(jfl) = ivtest(jfl) + 1 
     
    238236            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
    239237            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
    240             zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
    241                &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    242                &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             & 
    243                &                 + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
    244                &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    245                &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 
     238            zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
     239               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
     240               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             & 
     241               &                 + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
     242               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
     243               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 
    246244         ELSE 
    247245            zgifl(jfl) = 0.e0 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90

    r5836 r5845  
    2626   INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc   ! 1D workspace 
    2727 
    28    !! * Substitutions 
    29 #  include "domzgr_substitute.h90" 
    3028   !!---------------------------------------------------------------------- 
    3129   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     
    5250      !! ** Purpose :   
    5351      !!              
    54       !!     
    5552      !!       
    5653      !! ** Method  :   The frequency of  ??? is nwritefl 
    5754      !!       
    5855      !!---------------------------------------------------------------------- 
    59       !! * Arguments 
    6056      INTEGER  :: kt                            ! time step 
    61  
    62       !! * Local declarations 
     57      ! 
    6358      CHARACTER (len=80)       :: clname             ! restart filename 
    6459      INTEGER                  :: ic , jc , jpn ,jfl ! temporary integer 
     
    125120            ENDIF 
    126121         ENDIF 
    127  
     122         ! 
    128123      ENDIF 
    129  
     124      ! 
    130125   END SUBROUTINE flo_rst 
    131  
    132126 
    133127#  else 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r5836 r5845  
    4040   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztem , zsal, zrho   ! 2D workspace 
    4141 
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    4543   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     
    125123               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    126124                     +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    127                zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)      
     125               zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)      
    128126 
    129127               !save temperature, salinity and density at this position 
     
    146144            zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    147145                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    148             zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
     146            zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl) 
    149147 
    150148            ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5836 r5845  
    3737 
    3838   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
     
    237236         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
    238237      ELSE 
    239          CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )    
     238         CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )    
    240239      ENDIF 
    241240      ! 
     
    248247         IF( lk_vvl ) THEN 
    249248            DO jk = 1, jpk 
    250                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     249               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    251250            END DO 
    252251         ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r4679 r5845  
    1111   !!   mpp_init_ioispl: IOIPSL initialization in mpp 
    1212   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1413   USE dom_oce         ! ocean space and time domain  
    1514   USE in_out_manager  ! I/O Manager 
     
    2322   PUBLIC mpp_init2      ! called by opa.F90 
    2423 
    25    !! * Substitutions 
    26 #  include "domzgr_substitute.h90" 
    2724   !!---------------------------------------------------------------------- 
    2825   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90

    r5836 r5845  
    2828  
    2929   !! * Substitutions 
    30 #  include "domzgr_substitute.h90" 
    3130#  include "vectopt_loop_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
     
    7271      CASE( 'DYN' )                     ! T- and F-points 
    7372         DO jk = 1, jpk                      ! pah1 at T-point 
    74             pah1(:,:,jk) = pahs1(:,:) * (  prat + zc * ( 1._wp + TANH( - ( fsdept(:,:,jk) - zh ) * zw) )  ) * tmask(:,:,jk) 
     73            pah1(:,:,jk) = pahs1(:,:) * (  prat + zc * ( 1._wp + TANH( - ( gdept_n(:,:,jk) - zh ) * zw) )  ) * tmask(:,:,jk) 
    7574         END DO 
    7675         DO jk = 1, jpk                      ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 
    7776            DO jj = 1, jpjm1 
    7877               DO ji = 1, fs_jpim1 
    79                   zdep2 = (  fsdept(ji,jj+1,jk) + fsdept(ji+1,jj+1,jk)   & 
    80                      &     + fsdept(ji,jj  ,jk) + fsdept(ji+1,jj  ,jk)  ) * 0.25_wp 
     78                  zdep2 = (  gdept_n(ji,jj+1,jk) + gdept_n(ji+1,jj+1,jk)   & 
     79                     &     + gdept_n(ji,jj  ,jk) + gdept_n(ji+1,jj  ,jk)  ) * 0.25_wp 
    8180                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * fmask(ji,jj,jk) 
    8281               END DO 
     
    8988            DO jj = 1, jpjm1 
    9089               DO ji = 1, fs_jpim1 
    91                   zdep1 = (  fsdept(ji,jj,jk) + fsdept(ji+1,jj,jk)  ) * 0.5_wp 
    92                   zdep2 = (  fsdept(ji,jj,jk) + fsdept(ji,jj+1,jk)  ) * 0.5_wp 
     90                  zdep1 = (  gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk)  ) * 0.5_wp 
     91                  zdep2 = (  gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk)  ) * 0.5_wp 
    9392                  pah1(ji,jj,jk) = pahs1(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  ) * umask(ji,jj,jk) 
    9493                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * vmask(ji,jj,jk) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r5836 r5845  
    5252 
    5353   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5554#  include "vectopt_loop_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5836 r5845  
    7373 
    7474   !! * Substitutions 
    75 #  include "domzgr_substitute.h90" 
    7675#  include "vectopt_loop_substitute.h90" 
    7776   !!---------------------------------------------------------------------- 
     
    181180               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    182181               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    183                zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  ) 
    184                zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
     182               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau )  ) 
     183               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav )  ) 
    185184               !                                      ! uslp and vslp output in zwz and zww, resp. 
    186185               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
     
    188187               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
    189188                  &                   + zfi  * uslpml(ji,jj)                                                     & 
    190                   &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   & 
     189                  &                          * 0.5_wp * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk)-e3u_n(ji,jj,1) )   & 
    191190                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
    192191               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
    193192                  &                   + zfj  * vslpml(ji,jj)                                                     & 
    194                   &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   & 
     193                  &                          * 0.5_wp * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk)-e3v_n(ji,jj,1) )   & 
    195194                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
    196195!!gm  modif to suppress omlmask.... (as in Griffies case) 
     
    198197!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
    199198!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
    200 !               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
    201 !               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
     199!               zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
     200!               zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
    202201!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
    203202!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
     
    270269               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    271270               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    272                zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  ) 
    273                zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
     271               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai )  ) 
     272               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj )  ) 
    274273               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    275274               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    276                zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
     275               zck = gdepw_n(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
    277276               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
    278277               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
     
    281280!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
    282281!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
    283 !               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
     282!               zck = gdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
    284283!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    285284!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
     
    441440                     zdks = 0._wp 
    442441                  ENDIF 
    443                   zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
     442                  zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / e3w_n(ji,jj,jk+kp) 
    444443                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln 
    445444                 END DO 
     
    451450         DO ji = 1, jpi 
    452451            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    453             z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk) 
     452            z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk) 
    454453         END DO 
    455454      END DO 
     
    480479                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    481480                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    482                         &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
    483                      ze3_e1    =  fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)  
     481                        &          - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
     482                     ze3_e1    =  e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)  
    484483                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw ) 
    485484                  ENDIF 
     
    490489                  ELSE 
    491490                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    492                         &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    493                      ze3_e2    =  fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj) 
     491                        &      - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     492                     ze3_e2    =  e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj) 
    494493                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw ) 
    495494                  ENDIF 
     
    523522                     ! 
    524523                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    525                      zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 
    526                      ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked 
     524                     zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj  ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) 
     525                     ztj_coord = znot_thru_surface * ( gdept_n(ji  ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked 
    527526                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    528527                     ztj_g_raw = ztj_raw - ztj_coord 
    529528                     ! additional limit required in bilaplacian case 
    530                      ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj) 
    531                      ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj) 
     529                     ze3_e1    = e3w_n(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj) 
     530                     ze3_e2    = e3w_n(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj) 
    532531                     ! NB: hard coded factor 5 (can be a namelist parameter...) 
    533532                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 
     
    542541                     zti_g_lim =          ( zfacti   * zti_g_lim                       & 
    543542                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   & 
    544                         &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 
     543                        &                           * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 
    545544                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       & 
    546545                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   & 
    547                         &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 
     546                        &                           * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 
    548547                     ! 
    549548                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim 
     
    577576                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 
    578577                     ! 
    579                      zbu  = e1e2u(ji   ,jj   ) * fse3u(ji   ,jj   ,jk   ) 
    580                      zbv  = e1e2v(ji   ,jj   ) * fse3v(ji   ,jj   ,jk   ) 
    581                      zbti = e1e2t(ji+ip,jj   ) * fse3w(ji+ip,jj   ,jk+kp) 
    582                      zbtj = e1e2t(ji   ,jj+jp) * fse3w(ji   ,jj+jp,jk+kp) 
     578                     zbu  = e1e2u(ji   ,jj   ) * e3u_n(ji   ,jj   ,jk   ) 
     579                     zbv  = e1e2v(ji   ,jj   ) * e3v_n(ji   ,jj   ,jk   ) 
     580                     zbti = e1e2t(ji+ip,jj   ) * e3w_n(ji+ip,jj   ,jk+kp) 
     581                     zbtj = e1e2t(ji   ,jj+jp) * e3w_n(ji   ,jj+jp,jk+kp) 
    583582                     ! 
    584583                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked 
     
    682681            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    683682            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    684             zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
    685             zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
     683            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau )  ) 
     684            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav )  ) 
    686685            !                        !- Slope at u- & v-points (uslpml, vslpml) 
    687686            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 
     
    705704            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    706705            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    707             zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai )  ) 
    708             zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  ) 
     706            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai )  ) 
     707            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj )  ) 
    709708            !                        !- i- & j-slope at w-points (wslpiml, wslpjml) 
    710709            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 
     
    775774! 
    776775!            ! set the slope of diffusion to the slope of s-surfaces 
    777 !            !      ( c a u t i o n : minus sign as fsdep has positive value ) 
     776!            !      ( c a u t i o n : minus sign as dep has positive value ) 
    778777!            DO jk = 1, jpk 
    779778!               DO jj = 2, jpjm1 
    780779!                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    781 !                     uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    782 !                     vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    783 !                     wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 
    784 !                     wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     780!                     uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     781!                     vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     782!                     wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     783!                     wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 
    785784!                  END DO 
    786785!               END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r5836 r5845  
    8181 
    8282   !! * Substitutions 
    83 #  include "domzgr_substitute.h90" 
    8483#  include "vectopt_loop_substitute.h90" 
    8584   !!---------------------------------------------------------------------- 
     
    515514                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
    516515                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    517                   zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     516                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 
    518517                  ! Compute elements required for the inverse time scale of baroclinic 
    519518                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
    520519                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    521                   ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     520                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
    522521                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 
    523522                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
     
    533532                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
    534533                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    535                   zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     534                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 
    536535                  ! Compute elements required for the inverse time scale of baroclinic 
    537536                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
    538537                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    539                   ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     538                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
    540539                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    541540                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 
     
    711710      ! 
    712711      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    713          zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) ) 
     712         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 
    714713      END DO 
    715714      CALL iom_put( "uoce_eiv", zw3d ) 
    716715      ! 
    717716      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    718          zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) ) 
     717         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 
    719718      END DO 
    720719      CALL iom_put( "voce_eiv", zw3d ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5836 r5845  
    172172         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    173173         ! 
    174 #if defined key_vvl 
    175174      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
    176 #endif 
    177175         ! 
    178176      sbc_oce_alloc = MAXVAL( ierr ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r5836 r5845  
    3737    
    3838   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r5836 r5845  
    3939   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read) 
    4040 
    41    !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4341   !!---------------------------------------------------------------------- 
    4442   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5583 r5845  
    9393 
    9494   !! * Substitutions 
    95 #  include "domzgr_substitute.h90" 
    9695#  include "vectopt_loop_substitute.h90" 
    9796   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r5836 r5845  
    4242          
    4343   !! * Substitutions 
    44 #  include "domzgr_substitute.h90" 
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5836 r5845  
    165165 
    166166   !! Substitution 
    167 #  include "domzgr_substitute.h90" 
    168167#  include "vectopt_loop_substitute.h90" 
    169168   !!---------------------------------------------------------------------- 
     
    20022001      !                                                        ! first T level thickness  
    20032002      IF( ssnd(jps_e3t1st )%laction )  THEN 
    2004          CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2003         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
    20052004      ENDIF 
    20062005      !                                                        ! Qsr fraction 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r5836 r5845  
    1717   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr 
    1818   USE phycst          ! physical constants 
     19   ! 
    1920   USE fldread         ! read input fields 
    2021   USE iom             ! IOM library 
     
    3738 
    3839   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4040#  include "vectopt_loop_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
     
    165165               WRITE(numout,*)  
    166166               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 
    167                CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout ) 
    168167            END DO 
    169             CALL FLUSH(numout) 
    170168         ENDIF 
    171169         ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r5643 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5836 r5845  
    99   !!---------------------------------------------------------------------- 
    1010   !!   sbc_ice_cice  : sea-ice model time-stepping and update ocean sbc over ice-covered area 
    11    !!    
    12    !!    
    1311   !!---------------------------------------------------------------------- 
    1412   USE oce             ! ocean dynamics and tracers 
     
    9290   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice 
    9391 
    94    !! * Substitutions 
    95 #  include "domzgr_substitute.h90" 
    9692   !!---------------------------------------------------------------------- 
    9793   !! NEMO/OPA 3.7 , NEMO-consortium (2015)  
     
    249245            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    250246#if defined key_vvl             
    251            ! key_vvl necessary? clem: yes for compilation purpose 
     247!!gm key_vvl necessary? clem: yes for compilation purpose 
     248!!gm same remark as in limsbc 
    252249            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    253                fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    254                fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     250               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     251               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    255252            ENDDO 
    256             fse3t_a(:,:,:) = fse3t_b(:,:,:) 
     253            e3t_a(:,:,:) = e3t_b(:,:,:) 
    257254            ! Reconstruction of all vertical scale factors at now and before time 
    258255            ! steps 
     
    260257            ! Horizontal scale factor interpolations 
    261258            ! -------------------------------------- 
    262             CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
    263             CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
    264             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
    265             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
    266             CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 
     259            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
     260            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     261            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     262            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     263            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    267264            ! Vertical scale factor interpolations 
    268265            ! ------------------------------------ 
    269             CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
    270             CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
    271             CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
    272             CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
    273             CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
     266            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
     267            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
     268            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     269            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     270            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
    274271            ! t- and w- points depth 
    275272            ! ---------------------- 
    276             fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
    277             fsdepw_n(:,:,1) = 0.0_wp 
    278             fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
     273            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     274            gdepw_n(:,:,1) = 0.0_wp 
     275            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    279276            DO jk = 2, jpk 
    280                fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
    281                fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
    282                fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
     277               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
     278               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
     279               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
    283280            END DO 
    284281#endif 
     
    448445! Freezing/melting potential 
    449446! Calculated over NEMO leapfrog timestep (hence 2*dt) 
    450       nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt) 
     447      nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 
    451448 
    452449      ztmp(:,:) = nfrzmlt(:,:) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r5541 r5845  
    3434   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read) 
    3535    
    36    !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5541 r5845  
    7474    
    7575   !! * Substitutions 
    76 #  include "domzgr_substitute.h90" 
    7776#  include "vectopt_loop_substitute.h90" 
    7877   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5541 r5845  
    6464 
    6565   !! * Substitutions 
    66 #  include "domzgr_substitute.h90" 
    6766#  include "vectopt_loop_substitute.h90" 
    6867   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5836 r5845  
    6868   TYPE(FLD_N)       , PUBLIC ::   sn_depmax_isf, sn_depmin_isf, sn_Leff_isf     !: information about the runoff file to be read 
    6969    
    70    !! * Substitutions 
    71 #  include "domzgr_substitute.h90" 
    7270   !!---------------------------------------------------------------------- 
    7371   !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015) 
     
    170168              DO jj = 1, jpj 
    171169                  jk = 2 
    172                   DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO 
     170                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_n(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    173171                  misfkt(ji,jj) = jk-1 
    174172               END DO 
     
    195193               ikb = misfkt(ji,jj) 
    196194               ! thickness of boundary layer at least the top level thickness 
    197                rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt)) 
     195               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 
    198196 
    199197               ! determine the deepest level influenced by the boundary layer 
    200198               ! test on tmask useless ????? 
    201199               DO jk = ikt, mbkt(ji,jj) 
    202                   IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     200                  IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    203201               END DO 
    204                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     202               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    205203               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
    206204               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    207205 
    208                zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
    209                ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     206               zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
     207               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
    210208            END DO 
    211209         END DO 
     
    369367             ! after verif with UNESCO, wrong sign in BG eq. 2 
    370368             ! Calculate freezing temperature 
    371                 zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04  
     369                zpress = grav*rau0*gdept_n(ji,jj,ik)*1.e-04  
    372370                CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress)  
    373                 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp 
     371                zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * e3t_n(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp 
    374372             ENDDO 
    375373             zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value 
     
    445443            ! Crude approximation for pressure (but commonly used) 
    446444            ! 1e-04 to convert from Pa to dBar 
    447             zpress(ji,jj)=grav*rau0*fsdepw(ji,jj,mikt(ji,jj))*1.e-04 
     445            zpress(ji,jj)=grav*rau0*gdepw_n(ji,jj,mikt(ji,jj))*1.e-04 
    448446            ! 
    449447         END DO 
     
    643641               ELSE 
    644642      !! compute Rc number (as done in zdfric.F90) 
    645                zcoef = 0.5 / fse3w(ji,jj,ikt) 
     643               zcoef = 0.5 / e3w_n(ji,jj,ikt) 
    646644               !                                            ! shear of horizontal velocity 
    647645               zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )   & 
     
    663661               zts(jp_tem) = ttbl(ji,jj) 
    664662               zts(jp_sal) = stbl(ji,jj) 
    665                zdep        = fsdepw(ji,jj,ikt) 
     663               zdep        = gdepw_n(ji,jj,ikt) 
    666664               ! 
    667665               CALL eos_rab( zts, zdep, zab ) 
     
    672670      !! compute Monin Obukov Length 
    673671               ! Maximum boundary layer depth 
    674                zhmax = fsdept(ji,jj,mbkt(ji,jj)) - fsdepw(ji,jj,mikt(ji,jj)) -0.001 
     672               zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001 
    675673               ! Compute Monin obukhov length scale at the surface and Ekman depth: 
    676674               zmob   = zustar ** 3 / (vkarmn * (zbuofdep + epsln)) 
     
    730728               ! level fully include in the ice shelf boundary layer 
    731729               DO jk = ikt, ikb - 1 
    732                   ze3 = fse3t_n(ji,jj,jk) 
     730                  ze3 = e3t_n(ji,jj,jk) 
    733731                  IF (cptin == 'T' ) varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3 
    734732                  IF (cptin == 'U' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji-1,jj,jk)) & 
     
    739737 
    740738               ! level partially include in ice shelf boundary layer  
    741                zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 
     739               zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 
    742740               IF (cptin == 'T') & 
    743741                   &  varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 
     
    788786               ikb = misfkt(ji,jj) 
    789787               ! thickness of boundary layer at least the top level thickness 
    790                rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t(ji,jj,ikt)) 
     788               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 
    791789 
    792790               ! determine the deepest level influenced by the boundary layer 
    793791               ! test on tmask useless ????? 
    794792               DO jk = ikt, mbkt(ji,jj) 
    795                   IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     793                  IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    796794               END DO 
    797                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     795               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    798796               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
    799797               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    800798 
    801                zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
    802                ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     799               zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
     800               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
    803801            END DO 
    804802         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5836 r5845  
    6262   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    6363       
    64    !! * Substitutions 
    65 #  include "domzgr_substitute.h90" 
    6664   !!---------------------------------------------------------------------- 
    6765   !! NEMO/OPA 4.0 , NEMO-consortium (2011)  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5836 r5845  
    6868   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
    6969  
    70    !! * Substitutions   
    71 #  include "domzgr_substitute.h90"   
    7270   !!---------------------------------------------------------------------- 
    7371   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    216214                  h_rnf(ji,jj) = 0._wp 
    217215                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 
    218                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
     216                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box 
    219217                  END DO 
    220218                  !                          ! apply the runoff input flow 
     
    235233      ELSE                       !==   runoff put only at the surface   ==! 
    236234         IF( lk_vvl ) THEN              ! variable volume case 
    237             h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box 
    238          ENDIF 
    239          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1) 
     235            h_rnf(:,:) = e3t_n(:,:,1)   ! recalculate h_rnf to be depth of top box 
     236         ENDIF 
     237         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
    240238      ENDIF 
    241239      ! 
     
    377375               h_rnf(ji,jj) = 0._wp 
    378376               DO jk = 1, nk_rnf(ji,jj) 
    379                   h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     377                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 
    380378               END DO 
    381379            END DO 
     
    435433               h_rnf(ji,jj) = 0._wp 
    436434               DO jk = 1, nk_rnf(ji,jj) 
    437                   h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     435                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 
    438436               END DO 
    439437            END DO 
     
    448446      ELSE                                       ! runoffs applied at the surface 
    449447         nk_rnf(:,:) = 1 
    450          h_rnf (:,:) = fse3t(:,:,1) 
     448         h_rnf (:,:) = e3t_n(:,:,1) 
    451449      ENDIF 
    452450      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5407 r5845  
    2828   PUBLIC   sbc_ssm_init    ! routine called by sbcmod.F90 
    2929 
    30    LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read 
    31                                                   ! from restart file 
     30   LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read from restart file 
    3231    
    33    !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3532   !!---------------------------------------------------------------------- 
    3633   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    8178         ENDIF 
    8279         ! 
    83          IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     80         IF( lk_vvl )   e3t_m(:,:) = e3t_n(:,:,1) 
    8481         ! 
    8582         frq_m(:,:) = fraqsr_1lev(:,:) 
     
    103100            ENDIF 
    104101            ! 
    105             IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 
     102            IF( lk_vvl )   e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
    106103            ! 
    107104            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
     
    131128         ENDIF 
    132129         ! 
    133          IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 
     130         IF( lk_vvl )   e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
    134131         ! 
    135132         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:) 
     
    144141            ssv_m(:,:) = ssv_m(:,:) * zcoef           ! 
    145142            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m] 
    146             IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     143            IF( lk_vvl )   e3t_m(:,:) = e3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
    147144            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    148145            ! 
     
    229226               sss_m(:,:) = zcoef * sss_m(:,:) 
    230227               ssh_m(:,:) = zcoef * ssh_m(:,:) 
    231                IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:) 
     228               IF( lk_vvl )   e3t_m(:,:) = zcoef * e3t_m(:,:) 
    232229               frq_m(:,:) = zcoef * frq_m(:,:) 
    233230            ELSE 
     
    247244         sss_m(:,:) = tsn(:,:,1,jp_sal) 
    248245         ssh_m(:,:) = sshn(:,:) 
    249          IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     246         IF( lk_vvl )   e3t_m(:,:) = e3t_n(:,:,1) 
    250247         frq_m(:,:) = 1._wp 
    251248         ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r5836 r5845  
    4747   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read) 
    4848 
    49    !! * Substitutions 
    50 #  include "domzgr_substitute.h90" 
    5149   !!---------------------------------------------------------------------- 
    5250   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r5836 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
     
    128127         !                                      !* distribute it on the vertical 
    129128         DO jk = 1, jpkm1 
    130             zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
    131             zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
     129            zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 
     130            zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 
    132131         END DO 
    133132         !                                      !* interpolate the stokes drift from t-point to u- and v-points 
     
    136135               DO ji = 1, jpim1 
    137136                   usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji  ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk) 
    138                    vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji  ,jj,jk) + zvsd_t(ji+1,jj,jk) ) * vmask(ji,jj,jk) 
     137                   vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji  ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk) 
    139138               END DO 
    140139            END DO 
     
    146145            DO jj = 2, jpjm1 
    147146               DO ji = fs_2, fs_jpim1   ! vector opt. 
    148                   ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     & 
    149                      &                 - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     & 
    150                      &                 + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     & 
    151                      &                 - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
     147                  ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     & 
     148                     &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     & 
     149                     &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     & 
     150                     &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
    152151               END DO   
    153152            END DO   
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r5836 r5845  
    8989         DO ji = 2, jpim1 
    9090            zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    91             zcoefs = -zcoef * hv(ji  ,jj-1) * e1_e2v(ji  ,jj-1)    ! south coefficient 
    92             zcoefw = -zcoef * hu(ji-1,jj  ) * e2_e1u(ji-1,jj  )    ! west coefficient 
    93             zcoefe = -zcoef * hu(ji  ,jj  ) * e2_e1u(ji  ,jj  )    ! east coefficient 
    94             zcoefn = -zcoef * hv(ji  ,jj  ) * e1_e2v(ji  ,jj  )    ! north coefficient 
     91            zcoefs = -zcoef * hv_n(ji  ,jj-1) * e1_e2v(ji  ,jj-1)    ! south coefficient 
     92            zcoefw = -zcoef * hu_n(ji-1,jj  ) * e2_e1u(ji-1,jj  )    ! west coefficient 
     93            zcoefe = -zcoef * hu_n(ji  ,jj  ) * e2_e1u(ji  ,jj  )    ! east coefficient 
     94            zcoefn = -zcoef * hv_n(ji  ,jj  ) * e1_e2v(ji  ,jj  )    ! north coefficient 
    9595            gcp(ji,jj,1) = zcoefs 
    9696            gcp(ji,jj,2) = zcoefw 
     
    110110 
    111111            !  south coefficient 
    112             zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
     112            zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1) 
    113113            zcoefs = zcoefs * bdyvmask(ji,jj-1) 
    114114            gcp(ji,jj,1) = zcoefs 
    115115 
    116116            !  west coefficient 
    117             zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
     117            zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj) 
    118118            zcoefw = zcoefw * bdyumask(ji-1,jj) 
    119119            gcp(ji,jj,2) = zcoefw 
    120120 
    121121            !  east coefficient 
    122             zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
     122            zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj) 
    123123            zcoefe = zcoefe * bdyumask(ji,jj) 
    124124            gcp(ji,jj,3) = zcoefe 
    125125 
    126126            !  north coefficient 
    127             zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
     127            zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj) 
    128128            zcoefn = zcoefn * bdyvmask(ji,jj) 
    129129            gcp(ji,jj,4) = zcoefn 
     
    148148               !  south coefficient 
    149149               IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 
    150                   zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
     150                  zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
    151151               ELSE 
    152                   zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
     152                  zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1) 
    153153               END IF 
    154154               gcp(ji,jj,1) = zcoefs 
     
    156156               !  west coefficient 
    157157               IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN 
    158                   zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
     158                  zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
    159159               ELSE 
    160                   zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
     160                  zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj) 
    161161               END IF 
    162162               gcp(ji,jj,2) = zcoefw 
     
    164164               !   east coefficient 
    165165               IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 
    166                   zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 
     166                  zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 
    167167               ELSE 
    168                   zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
     168                  zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj) 
    169169               END IF 
    170170               gcp(ji,jj,3) = zcoefe 
     
    172172               !   north coefficient 
    173173               IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 
    174                   zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
     174                  zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
    175175               ELSE 
    176                   zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
     176                  zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj) 
    177177               END IF 
    178178               gcp(ji,jj,4) = zcoefn 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5541 r5845  
    172172 
    173173   !! * Substitutions 
    174 #  include "domzgr_substitute.h90" 
    175174#  include "vectopt_loop_substitute.h90" 
    176175   !!---------------------------------------------------------------------- 
     
    587586               DO ji = 1, jpi 
    588587                  ! 
    589                   zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     588                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth 
    590589                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    591590                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     
    645644                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    646645                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    647                   zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point 
     646                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point 
    648647                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
    649648                  ! 
     
    913912         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
    914913            DO ji = 1, jpi 
    915                zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
    916                   &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     914               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     915                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )  
    917916                  ! 
    918917               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     
    921920               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
    922921                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
    923                   &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     922                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
    924923            END DO 
    925924         END DO 
     
    11291128               DO ji = 1, jpi 
    11301129                  ! 
    1131                   zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     1130                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth 
    11321131                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    11331132                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     
    11931192                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
    11941193                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
    1195                   zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point 
     1194                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point 
    11961195                  ztm = tmask(ji,jj,jk)                ! tmask 
    11971196                  zn  = 0.5_wp * zh * r1_rau0 * ztm 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5836 r5845  
    6666    
    6767   !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6968#  include "vectopt_loop_substitute.h90" 
    7069   !!---------------------------------------------------------------------- 
     
    102101      !                                         !==  effective transport  ==! 
    103102      DO jk = 1, jpkm1 
    104          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    105          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     103         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
     104         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    106105         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    107106      END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r5836 r5845  
    3434 
    3535   !! * Substitutions 
    36 #  include "domzgr_substitute.h90" 
    3736#  include "vectopt_loop_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
     
    183182                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
    184183                     &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    & 
    185                      &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) / ( e1e2t(ji,jj) *  fse3t_n(ji,jj,jk) ) 
     184                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) / ( e1e2t(ji,jj) *  e3t_n(ji,jj,jk) ) 
    186185               END DO 
    187186            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r5836 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
     
    156155                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    157156                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    158                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     157                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    159158                  ! update and guess with monotonic sheme 
    160159!!gm why tmask added in the two following lines ???    the mask is done in tranxt ! 
     
    296295                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    297296                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) & 
    298                      &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     297                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    299298               END DO 
    300299            END DO 
     
    450449                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    451450                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    452                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     451                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    453452                  ! update and guess with monotonic sheme 
    454453                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
     
    548547                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 & 
    549548                        &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    550                         &                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     549                        &                         / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    551550                  END DO 
    552551               END DO 
     
    577576                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       & 
    578577                     &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   & 
    579                      &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     578                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    580579               END DO 
    581580            END DO 
     
    680679 
    681680               ! up & down beta terms 
    682                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
     681               zbt = e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 
    683682               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
    684683               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r5836 r5845  
    4949 
    5050   !! * Substitutions 
    51 #  include "domzgr_substitute.h90" 
    5251#  include "vectopt_loop_substitute.h90" 
    5352   !!---------------------------------------------------------------------- 
     
    125124         DO jj = 1, jpj 
    126125            DO ji = 1, jpi 
    127                zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
     126               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    128127               zmld(ji,jj) = zmld(ji,jj) + zc 
    129128               zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 
     
    157156      END SELECT 
    158157      !                                                ! convert density into buoyancy 
    159       zbm(:,:) = + grav * zbm(:,:) / MAX( fse3t(:,:,1), zmld(:,:) ) 
     158      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) ) 
    160159      ! 
    161160      ! 
     
    215214         DO jj = 1, jpjm1 
    216215            DO ji = 1, fs_jpim1   ! vector opt. 
    217                zcuw = 1._wp - ( fsdepw(ji+1,jj,jk) + fsdepw(ji,jj,jk) ) * zhu(ji,jj) 
    218                zcvw = 1._wp - ( fsdepw(ji,jj+1,jk) + fsdepw(ji,jj,jk) ) * zhv(ji,jj) 
     216               zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj) 
     217               zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj) 
    219218               zcuw = zcuw * zcuw 
    220219               zcvw = zcvw * zcvw 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r5836 r5845  
    4242    
    4343   !! * Substitutions 
    44 #  include "domzgr_substitute.h90" 
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
     
    170169                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    171170                  zalpha = 0.5 - z0u 
    172                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     171                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    173172                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
    174173                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
     
    177176                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    178177                  zalpha = 0.5 - z0v 
    179                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     178                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
    180179                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
    181180                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
     
    191190                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    192191                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    193                   &                                   / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     192                  &                                   / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    194193               END DO 
    195194           END DO 
     
    243242                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    244243                  zalpha = 0.5 + z0w 
    245                   zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt  / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
     244                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt  / ( e1e2t(ji,jj) * e3w_n(ji,jj,jk+1) ) 
    246245                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
    247246                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
     
    268267            DO jj = 2, jpjm1       
    269268               DO ji = fs_2, fs_jpim1   ! vector opt. 
    270                   pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     269                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    271270               END DO 
    272271            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5836 r5845  
    3939 
    4040   !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    4241#  include "vectopt_loop_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
     
    171170               DO ji = fs_2, fs_jpim1   ! vector opt.    
    172171                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    173                   zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk) 
     172                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk) 
    174173                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    175174                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T 
     
    217216            DO jj = 2, jpjm1 
    218217               DO ji = fs_2, fs_jpim1   ! vector opt.   
    219                   zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     218                  zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    220219                  ! horizontal advective trends 
    221220                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    294293               DO ji = fs_2, fs_jpim1   ! vector opt.    
    295294                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    296                   zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk) 
     295                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
    297296                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    298297                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T 
     
    341340            DO jj = 2, jpjm1 
    342341               DO ji = fs_2, fs_jpim1   ! vector opt.   
    343                   zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     342                  zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    344343                  ! horizontal advective trends 
    345344                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    413412               DO ji = fs_2, fs_jpim1   ! vector opt. 
    414413                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    415                      &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     414                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    416415               END DO 
    417416            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r5836 r5845  
    3636 
    3737   !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
     
    122121            DO jj = 1, jpjm1              ! First derivative (masked gradient) 
    123122               DO ji = 1, fs_jpim1   ! vector opt. 
    124                   zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 
    125                   zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) 
     123                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     124                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    126125                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    127126                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     
    130129            DO jj = 2, jpjm1              ! Second derivative (divergence) 
    131130               DO ji = fs_2, fs_jpim1   ! vector opt. 
    132                   zcoef = 1._wp / ( 6._wp * fse3t(ji,jj,jk) ) 
     131                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) ) 
    133132                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
    134133                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef 
     
    163162                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        & 
    164163                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
    165                      &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     164                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    166165               END DO 
    167166            END DO 
     
    216215               DO jj = 2, jpjm1 
    217216                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    218                      ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     217                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    219218                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak  
    220219                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
     
    254253            DO jj = 2, jpjm1  
    255254               DO ji = fs_2, fs_jpim1   ! vector opt.    
    256                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     255                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    257256               END DO 
    258257            END DO 
     
    265264                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          & 
    266265                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   & 
    267                         &                              / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     266                        &                              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    268267                  END DO 
    269268               END DO 
     
    357356               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
    358357               ! up & down beta terms 
    359                zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
     358               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 
    360359               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 
    361360               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r5397 r5845  
    4040   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux 
    4141 
    42    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend 
     42   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend 
     43 
    4344   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read) 
    4445  
    45    !! * Substitutions 
    46 #  include "domzgr_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
    4847   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    9291         DO ji = 2, jpim1 
    9392            ik = mbkt(ji,jj) 
    94             zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 
     93            zqgh_trd = qgh_trd0(ji,jj) / e3t_n(ji,jj,ik) 
    9594            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 
    9695         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r5836 r5845  
    7070 
    7171   !! * Substitutions 
    72 #  include "domzgr_substitute.h90" 
    7372#  include "vectopt_loop_substitute.h90" 
    7473   !!---------------------------------------------------------------------- 
     
    211210                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    212211                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    213                   &             / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 
     212                  &             / ( e1e2t(ji,jj) * e3t_n(ji,jj,ik) ) 
    214213            END DO 
    215214         END DO 
     
    263262                  ! 
    264263                  !                                               ! up  -slope T-point (shelf bottom point) 
    265                   zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 
     264                  zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 
    266265                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    267266                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    268267                  ! 
    269268                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    270                      zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
     269                     zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 
    271270                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    272271                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    273272                  END DO 
    274273                  ! 
    275                   zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
     274                  zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 
    276275                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    277276                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     
    285284                  ! 
    286285                  ! up  -slope T-point (shelf bottom point) 
    287                   zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
     286                  zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 
    288287                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    289288                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    290289                  ! 
    291290                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    292                      zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
     291                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 
    293292                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    294293                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    295294                  END DO 
    296295                  !                                               ! down-slope T-point (deep bottom point) 
    297                   zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 
     296                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 
    298297                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    299298                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     
    365364            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
    366365            ! 
    367             zdep(ji,jj) = fsdept(ji,jj,ik)               ! bottom T-level reference depth 
     366            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth 
    368367            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
    369368            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r5836 r5845  
    5252 
    5353   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5554#  include "vectopt_loop_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
     
    139138            DO jj = 2, jpjm1 
    140139               DO ji = fs_2, fs_jpim1   ! vector opt. 
    141                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     140                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    142141                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
    143142                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r5836 r5845  
    4343    
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90

    r5836 r5845  
    4646 
    4747   !! * Substitutions 
    48 #  include "domzgr_substitute.h90" 
    4948#  include "vectopt_loop_substitute.h90" 
    5049   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5836 r5845  
    3838 
    3939   !! * Substitutions 
    40 #  include "domzgr_substitute.h90" 
    4140#  include "vectopt_loop_substitute.h90" 
    4241   !!---------------------------------------------------------------------- 
     
    183182                     DO ji = 1, fs_jpim1 
    184183                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
    185                            &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  ) 
     184                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  ) 
    186185                     END DO 
    187186                  END DO 
     
    191190                  DO jj = 1, jpjm1 
    192191                     DO ji = 1, fs_jpim1 
    193                         ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     192                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    194193                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    195194                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     
    269268            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    270269               DO ji = 1, fs_jpim1   ! vector opt. 
    271                   zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    272                   zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     270                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     271                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    273272                  ! 
    274273                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
     
    294293                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
    295294                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    296                      &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
     295                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
    297296               END DO 
    298297            END DO 
     
    343342               DO jj = 1, jpjm1 
    344343                  DO ji = fs_2, fs_jpim1 
    345                      ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   & 
     344                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   & 
    346345                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    347346                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     
    358357                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
    359358                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    360                            &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk) 
     359                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / e3w_n(ji,jj,jk) 
    361360                     END DO 
    362361                  END DO 
     
    366365                  DO jj = 1, jpjm1 
    367366                     DO ji = fs_2, fs_jpim1 
    368                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     367                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      & 
    369368                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
    370369                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     
    379378               DO ji = fs_2, fs_jpim1   ! vector opt. 
    380379                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
    381                      &                                        / (  e1e2t(ji,jj) * fse3t_n(ji,jj,jk)  ) 
     380                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
    382381               END DO 
    383382            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5836 r5845  
    3838 
    3939   !! * Substitutions 
    40 #  include "domzgr_substitute.h90" 
    4140#  include "vectopt_loop_substitute.h90" 
    4241   !!---------------------------------------------------------------------- 
     
    10099         DO jj = 1, jpjm1 
    101100            DO ji = 1, fs_jpim1   ! vector opt. 
    102                zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked! 
    103                zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk) 
     101               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked! 
     102               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk) 
    104103            END DO 
    105104         END DO 
     
    140139                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    141140                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
    142                      &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     141                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    143142               END DO 
    144143            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r5836 r5845  
    3737 
    3838   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
     
    142141                  DO jj = 1, jpjm1 
    143142                     DO ji = 1, fs_jpim1 
    144                         ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    145                         zbu   = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     143                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
     144                        zbu   = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    146145                        zah   = 0.25_wp * pahu(ji,jj,jk) 
    147146                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    148147                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
    149                         zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     148                        zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
    150149                        zslope2 = zslope2 *zslope2 
    151150                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 
     
    166165                  DO jj = 1, jpjm1 
    167166                     DO ji = 1, fs_jpim1 
    168                         ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 
    169                         zbv   = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     167                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp) 
     168                        zbv   = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    170169                        zah   = 0.25_wp * pahv(ji,jj,jk) 
    171170                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    172171                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    173172                        !    (do this by *adding* gradient of depth) 
    174                         zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     173                        zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
    175174                        zslope2 = zslope2 * zslope2 
    176175                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 
     
    193192                     DO ji = 1, fs_jpim1 
    194193                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
    195                            &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  ) 
     194                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  ) 
    196195                     END DO 
    197196                  END DO 
     
    201200                  DO jj = 1, jpjm1 
    202201                     DO ji = 1, fs_jpim1 
    203                         ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     202                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    204203                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    205204                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     
    274273                           ze1ur = r1_e1u(ji,jj) 
    275274                           zdxt  = zdit(ji,jj,jk) * ze1ur 
    276                            ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     275                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
    277276                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    278277                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    279278                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp) 
    280279 
    281                            zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     280                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    282281                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
    283282                           zah = pahu(ji,jj,jk) 
     
    297296                           ze2vr = r1_e2v(ji,jj) 
    298297                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
    299                            ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
     298                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 
    300299                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    301300                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    302301                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    303                            zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     302                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    304303                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked... 
    305304                           zah = pahv(ji,jj,jk) 
     
    321320                           ze1ur = r1_e1u(ji,jj) 
    322321                           zdxt  = zdit(ji,jj,jk) * ze1ur 
    323                            ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     322                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
    324323                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    325324                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    326325                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    327326 
    328                            zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     327                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    329328                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
    330329                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
    331330                           zah_slp  = zah * zslope_iso 
    332                            IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew 
     331                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew 
    333332                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    334333                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
     
    344343                           ze2vr = r1_e2v(ji,jj) 
    345344                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
    346                            ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
     345                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 
    347346                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    348347                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    349348                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    350                            zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     349                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    351350                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
    352351                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ???? 
    353352                           zah_slp = zah * zslope_iso 
    354                            IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
     353                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew 
    355354                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    356355                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
     
    365364                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
    366365                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   & 
    367                      &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
     366                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
    368367               END DO 
    369368            END DO 
     
    376375               DO jj = 1, jpjm1 
    377376                  DO ji = fs_2, fs_jpim1 
    378                      ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   & 
     377                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   & 
    379378                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    380379                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     
    388387                  DO jj = 1, jpjm1 
    389388                     DO ji = fs_2, fs_jpim1 
    390                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)             & 
     389                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)             & 
    391390                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
    392391                     END DO 
     
    397396                  DO jj = 1, jpjm1 
    398397                     DO ji = fs_2, fs_jpim1 
    399                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     398                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      & 
    400399                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
    401400                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     
    410409               DO ji = fs_2, fs_jpim1  ! vector opt. 
    411410                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
    412                      &                                        / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     411                     &                                        / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    413412               END DO 
    414413            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r5386 r5845  
    3535 
    3636   !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3837#  include "vectopt_loop_substitute.h90" 
    3938   !!---------------------------------------------------------------------- 
     
    195194                           DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column 
    196195                              ! 
    197                               zdz       = fse3t(ji,jj,jk) 
     196                              zdz       = e3t_n(ji,jj,jk) 
    198197                              zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 
    199198                              zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz 
     
    244243 
    245244                              !! Interpolating alfa and beta at W point: 
    246                               zrw =  (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) & 
    247                                  & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk)) 
     245                              zrw =  (gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk)) & 
     246                                 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk)) 
    248247                              zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 
    249248                              zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw 
     
    252251                              zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
    253252                                 &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  & 
    254                                  &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     253                                 &       / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
    255254 
    256255                              !! OR, faster  => just considering the vertical gradient of density 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5836 r5845  
    6060   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
    6161 
    62    !! * Substitutions 
    63 #  include "domzgr_substitute.h90" 
    6462   !!---------------------------------------------------------------------- 
    6563   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)  
     
    310308            DO jj = 1, jpj 
    311309               DO ji = 1, jpi 
    312                   ze3t_b = fse3t_b(ji,jj,jk) 
    313                   ze3t_n = fse3t_n(ji,jj,jk) 
    314                   ze3t_a = fse3t_a(ji,jj,jk) 
     310                  ze3t_b = e3t_b(ji,jj,jk) 
     311                  ze3t_n = e3t_n(ji,jj,jk) 
     312                  ze3t_a = e3t_a(ji,jj,jk) 
    315313                  !                                         ! tracer content at Before, now and after 
    316314                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b 
     
    338336                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          & 
    339337                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
    340                      &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     338                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj) 
    341339 
    342340                  ! ice shelf 
     
    345343                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          & 
    346344                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
    347                                &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 
     345                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 
    348346                     ! level partially include in Losch_2008 ice shelf boundary layer  
    349347                     IF ( jk == misfkb(ji,jj) )                                                   & 
    350348                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
    351                                &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 
     349                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 
    352350                  END IF 
    353351 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r5836 r5845  
    5858 
    5959   !! * Substitutions 
    60 #  include "domzgr_substitute.h90" 
    6160#  include "vectopt_loop_substitute.h90" 
    6261   !!---------------------------------------------------------------------- 
     
    157156            DO jj = 2, jpjm1  
    158157               DO ji = fs_2, fs_jpim1   ! vector opt. 
    159                   z1_e3t = zfact / fse3t(ji,jj,jk) 
     158                  z1_e3t = zfact / e3t_n(ji,jj,jk) 
    160159                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 
    161160               END DO 
     
    216215                  DO jj = 1, jpj 
    217216                     DO ji = 1, jpi 
    218                         zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     ) 
    219                         zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) ) 
    220                         zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) ) 
    221                         zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) ) 
     217                        zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r     ) 
     218                        zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) ) 
     219                        zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) ) 
     220                        zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) ) 
    222221                        ze0(ji,jj,jk) = zc0 
    223222                        ze1(ji,jj,jk) = zc1 
     
    232231                  DO jj = 1, jpj 
    233232                     DO ji = 1, jpi 
    234                         zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
    235                         zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
    236                         zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
    237                         zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
     233                        zzc0 = rn_abs * EXP( - e3t_n(ji,jj,1) * xsi0r     ) 
     234                        zzc1 = zcoef  * EXP( - e3t_n(ji,jj,1) * zekb(ji,jj) ) 
     235                        zzc2 = zcoef  * EXP( - e3t_n(ji,jj,1) * zekg(ji,jj) ) 
     236                        zzc3 = zcoef  * EXP( - e3t_n(ji,jj,1) * zekr(ji,jj) ) 
    238237                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    239238                     END DO 
     
    268267                  DO jj = 1, jpj 
    269268                     DO ji = 1, jpi 
    270                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    271                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
     269                        zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r ) 
     270                        zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r ) 
    272271                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) )  
    273272                     END DO 
     
    278277                  DO jj = 1, jpj 
    279278                     DO ji = 1, jpi 
    280                         zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
    281                         zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
     279                        zc0 = zz0 * EXP( -gdepw_n(ji,jj,1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,1)*xsi1r ) 
     280                        zc1 = zz0 * EXP( -gdepw_n(ji,jj,2)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,2)*xsi1r ) 
    282281                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    283282                     END DO 
     
    306305            DO jj = 2, jpjm1  
    307306               DO ji = fs_2, fs_jpim1   ! vector opt. 
    308                   z1_e3t = zfact / fse3t(ji,jj,jk) 
     307                  z1_e3t = zfact / e3t_n(ji,jj,jk) 
    309308                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 
    310309               END DO 
     
    533532                  DO jj = 1, jpj                              ! top 400 meters 
    534533                     DO ji = 1, jpi 
    535                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    536                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
     534                        zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r ) 
     535                        zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r ) 
    537536                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1)  
    538537                     END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5643 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
     
    196195         DO jj = 2, jpj 
    197196            DO ji = fs_2, fs_jpim1   ! vector opt. 
    198                z1_e3t = zfact / fse3t(ji,jj,1) 
     197               z1_e3t = zfact / e3t_n(ji,jj,1) 
    199198               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t 
    200199            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r5836 r5845  
    4444 
    4545   !! * Substitutions 
    46 #  include "domzgr_substitute.h90" 
    4746#  include "zdfddm_substitute.h90" 
    4847#  include "vectopt_loop_substitute.h90" 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r3294 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "zdfddm_substitute.h90" 
    4443#  include "vectopt_loop_substitute.h90" 
     
    122121               DO jj = 2, jpjm1  
    123122                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                      zave3r = 1.e0 / fse3w_n(ji,jj,jk)  
     123                     zave3r = 1.e0 / e3w_n(ji,jj,jk)  
    125124                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt 
    126125                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r 
     
    135134               DO jj = 2, jpjm1  
    136135                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    137                      ze3tr = zlavmr / fse3t_n(ji,jj,jk) 
     136                     ze3tr = zlavmr / e3t_n(ji,jj,jk) 
    138137                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr 
    139138                  END DO 
     
    149148               DO jj = 2, jpjm1  
    150149                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    151                      ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t 
     150                     ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)                          ! before e3t 
    152151                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt  
    153152                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r5836 r5845  
    4545 
    4646   !! * Substitutions 
    47 #  include "domzgr_substitute.h90" 
    4847#  include "zdfddm_substitute.h90" 
    4948#  include "vectopt_loop_substitute.h90" 
     
    142141               DO jj = 2, jpjm1 
    143142                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    144                      ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point 
    145                      ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point 
    146                      zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) ) 
    147                      zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 
     143                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * e3t_a(ji,jj,jk)   ! after scale factor at T-point 
     144                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * e3t_n(ji,jj,jk)   ! now   scale factor at T-point 
     145                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * e3w_n(ji,jj,jk  ) ) 
     146                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_n(ji,jj,jk+1) ) 
    148147                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    149148                 END DO 
     
    190189         DO jj = 2, jpjm1 
    191190            DO ji = fs_2, fs_jpim1 
    192                ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1) 
    193                ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 
     191               ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_b(ji,jj,1) 
     192               ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_n(ji,jj,1) 
    194193               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 
    195194            END DO 
     
    198197            DO jj = 2, jpjm1 
    199198               DO ji = fs_2, fs_jpim1 
    200                   ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk) 
    201                   ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk) 
     199                  ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_b(ji,jj,jk) 
     200                  ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_n(ji,jj,jk) 
    202201                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side  
    203202                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r5836 r5845  
    3232 
    3333   !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3534#  include "vectopt_loop_substitute.h90" 
    3635   !!---------------------------------------------------------------------- 
     
    111110               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    112111               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    113                ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    114                ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     112               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
     113               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
    115114               ! 
    116115               ! i- direction 
    117116               IF( ze3wu >= 0._wp ) THEN      ! case 1 
    118                   zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
     117                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku) 
    119118                  ! interpolated values of tracers 
    120119                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     
    122121                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    123122               ELSE                           ! case 2 
    124                   zmaxu = -ze3wu / fse3w(ji,jj,iku) 
     123                  zmaxu = -ze3wu / e3w_n(ji,jj,iku) 
    125124                  ! interpolated values of tracers 
    126125                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     
    131130               ! j- direction 
    132131               IF( ze3wv >= 0._wp ) THEN      ! case 1 
    133                   zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
     132                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv) 
    134133                  ! interpolated values of tracers 
    135134                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     
    137136                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    138137               ELSE                           ! case 2 
    139                   zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
     138                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv) 
    140139                  ! interpolated values of tracers 
    141140                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     
    156155               iku = mbku(ji,jj) 
    157156               ikv = mbkv(ji,jj) 
    158                ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    159                ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
    160                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1 
    161                ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2 
    162                ENDIF 
    163                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1 
    164                ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2 
     157               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
     158               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
     159               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1 
     160               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2 
     161               ENDIF 
     162               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1 
     163               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2 
    165164               ENDIF 
    166165            END DO 
     
    174173               iku = mbku(ji,jj) 
    175174               ikv = mbkv(ji,jj) 
    176                ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    177                ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     175               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
     176               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
    178177               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
    179178               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     
    288287               ! i- direction 
    289288               IF( ze3wu >= 0._wp ) THEN      ! case 1 
    290                   zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
     289                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku) 
    291290                  ! interpolated values of tracers 
    292291                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     
    294293                  pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    295294               ELSE                           ! case 2 
    296                   zmaxu = -ze3wu / fse3w(ji,jj,iku) 
     295                  zmaxu = -ze3wu / e3w_n(ji,jj,iku) 
    297296                  ! interpolated values of tracers 
    298297                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     
    303302               ! j- direction 
    304303               IF( ze3wv >= 0._wp ) THEN      ! case 1 
    305                   zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
     304                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv) 
    306305                  ! interpolated values of tracers 
    307306                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     
    309308                  pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    310309               ELSE                           ! case 2 
    311                   zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
     310                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv) 
    312311                  ! interpolated values of tracers 
    313312                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     
    335334               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 
    336335               ! 
    337                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu     ! i-direction: case 1 
    338                ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) + ze3wu    ! -     -      case 2 
    339                ENDIF 
    340                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv    ! j-direction: case 1 
    341                ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) + ze3wv    ! -     -      case 2 
     336               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku) - ze3wu     ! i-direction: case 1 
     337               ELSE                        ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku) + ze3wu    ! -     -      case 2 
     338               ENDIF 
     339               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv) - ze3wv    ! j-direction: case 1 
     340               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv) + ze3wv    ! -     -      case 2 
    342341               ENDIF 
    343342            END DO 
     
    354353               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 
    355354               IF( ze3wu >= 0._wp ) THEN  
    356                   pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku) 
     355                  pgzu(ji,jj) = (gde3w_n(ji+1,jj,iku) - ze3wu) - gde3w_n(ji,jj,iku) 
    357356                  pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1 
    358357                  pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) + prd(ji,jj,iku) )   ! i: 1  
    359358                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  & 
    360                                 * ( (fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji  ,jj    ) + prd(ji+1,jj,ikum1) + 2._wp) & 
    361                                    - fse3w(ji  ,jj,iku)          * ( prd(ji  ,jj,iku) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2 
     359                                * ( (e3w_n(ji+1,jj,iku) - ze3wu )* ( zri(ji  ,jj    ) + prd(ji+1,jj,ikum1) + 2._wp) & 
     360                                   - e3w_n(ji  ,jj,iku)          * ( prd(ji  ,jj,iku) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2 
    362361               ELSE   
    363                   pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu) 
     362                  pgzu(ji,jj) = gde3w_n(ji+1,jj,iku) - (gde3w_n(ji,jj,iku) + ze3wu) 
    364363                  pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2 
    365364                  pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) )   ! i: 2 
    366365                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  & 
    367                                 * (  fse3w(ji+1,jj,iku)          * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) & 
    368                                    -(fse3w(ji  ,jj,iku) + ze3wu) * ( zri(ji  ,jj    ) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2 
     366                                * (  e3w_n(ji+1,jj,iku)          * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) & 
     367                                   -(e3w_n(ji  ,jj,iku) + ze3wu) * ( zri(ji  ,jj    ) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2 
    369368               ENDIF 
    370369               IF( ze3wv >= 0._wp ) THEN 
    371                   pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv)  
     370                  pgzv(ji,jj) = (gde3w_n(ji,jj+1,ikv) - ze3wv) - gde3w_n(ji,jj,ikv)  
    372371                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1 
    373372                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )   ! j: 1 
    374373                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  & 
    375                                 * ( (fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj      ) + prd(ji,jj+1,ikvm1) + 2._wp) & 
    376                                    - fse3w(ji,jj  ,ikv)          * ( prd(ji,jj  ,ikv) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2 
     374                                * ( (e3w_n(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj      ) + prd(ji,jj+1,ikvm1) + 2._wp) & 
     375                                   - e3w_n(ji,jj  ,ikv)          * ( prd(ji,jj  ,ikv) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2 
    377376               ELSE  
    378                   pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv) 
     377                  pgzv(ji,jj) = gde3w_n(ji,jj+1,ikv) - (gde3w_n(ji,jj,ikv) + ze3wv) 
    379378                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2 
    380379                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )   ! j: 2 
    381380                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  & 
    382                                 * (  fse3w(ji,jj+1,ikv)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) & 
    383                                    -(fse3w(ji,jj  ,ikv) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2 
     381                                * (  e3w_n(ji,jj+1,ikv)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) & 
     382                                   -(e3w_n(ji,jj  ,ikv) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2 
    384383               ENDIF 
    385384            END DO 
     
    408407               ! i- direction 
    409408               IF( ze3wu >= 0._wp ) THEN      ! case 1 
    410                   zmaxu = ze3wu / fse3w(ji+1,jj,iku+1) 
     409                  zmaxu = ze3wu / e3w_n(ji+1,jj,iku+1) 
    411410                  ! interpolated values of tracers 
    412411                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) ) 
     
    414413                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    415414               ELSE                           ! case 2 
    416                   zmaxu = - ze3wu / fse3w(ji,jj,iku+1) 
     415                  zmaxu = - ze3wu / e3w_n(ji,jj,iku+1) 
    417416                  ! interpolated values of tracers 
    418417                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 
     
    423422               ! j- direction 
    424423               IF( ze3wv >= 0._wp ) THEN      ! case 1 
    425                   zmaxv =  ze3wv / fse3w(ji,jj+1,ikv+1) 
     424                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv+1) 
    426425                  ! interpolated values of tracers 
    427426                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) 
     
    429428                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    430429               ELSE                           ! case 2 
    431                   zmaxv =  - ze3wv / fse3w(ji,jj,ikv+1) 
     430                  zmaxv =  - ze3wv / e3w_n(ji,jj,ikv+1) 
    432431                  ! interpolated values of tracers 
    433432                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 
     
    452451               iku = miku(ji,jj) 
    453452               ikv = mikv(ji,jj) 
    454                ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
    455                ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    456                ! 
    457                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu    ! i-direction: case 1 
    458                ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) - ze3wu    ! -     -      case 2 
    459                ENDIF 
    460                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv    ! j-direction: case 1 
    461                ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) - ze3wv    ! -     -      case 2 
     453               ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
     454               ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
     455               ! 
     456               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku) + ze3wu    ! i-direction: case 1 
     457               ELSE                        ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku) - ze3wu    ! -     -      case 2 
     458               ENDIF 
     459               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv) + ze3wv    ! j-direction: case 1 
     460               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv) - ze3wv    ! -     -      case 2 
    462461               ENDIF 
    463462            END DO 
     
    474473               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    475474               IF( ze3wu >= 0._wp ) THEN 
    476                  pgzui  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 
     475                 pgzui  (ji,jj) = (gde3w_n(ji+1,jj,iku) + ze3wu) - gde3w_n(ji,jj,iku) 
    477476                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1 
    478477                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1  
    479478                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  & 
    480                     &           * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   & 
    481                     &              - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1 
     479                    &           * ( (e3w_n(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   & 
     480                    &              - e3w_n(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1 
    482481               ELSE 
    483                  pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 
     482                 pgzui  (ji,jj) = gde3w_n(ji+1,jj,iku) - (gde3w_n(ji,jj,iku) - ze3wu) 
    484483                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2 
    485484                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2 
    486485                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   & 
    487                     &           * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  & 
    488                     &              -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2 
     486                    &           * (  e3w_n(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  & 
     487                    &              -(e3w_n(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2 
    489488               ENDIF 
    490489               IF( ze3wv >= 0._wp ) THEN 
    491                  pgzvi  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)  
     490                 pgzvi  (ji,jj) = (gde3w_n(ji,jj+1,ikv) + ze3wv) - gde3w_n(ji,jj,ikv)  
    492491                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1 
    493492                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1 
    494493                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  &  
    495                      &           * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  & 
    496                      &                - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1 
     494                     &           * ( (e3w_n(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  & 
     495                     &              - e3w_n(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1 
    497496                                  ! + 2 due to the formulation in density and not in anomalie in hpg sco 
    498497               ELSE 
    499                  pgzvi  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 
     498                 pgzvi  (ji,jj) = gde3w_n(ji,jj+1,ikv) - (gde3w_n(ji,jj,ikv) - ze3wv) 
    500499                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2 
    501500                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2 
    502501                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   & 
    503                     &           * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 
    504                     &              -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
     502                    &           * (  e3w_n(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 
     503                    &              -(e3w_n(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
    505504               ENDIF 
    506505            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90

    r5215 r5845  
    3636 
    3737   !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
     
    147146                              !                                    ! wind stress trends 
    148147                              CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
    149                               z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( fse3u(:,:,1) * rau0 ) 
    150                               z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( fse3v(:,:,1) * rau0 ) 
     148                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 
     149                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 
    151150                              CALL iom_put( "utrd_tau", z2dx ) 
    152151                              CALL iom_put( "vtrd_tau", z2dy ) 
     
    165164                                          ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    166165                                          ikbv = mbkv(ji,jj) 
    167                                           z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu) 
    168                                           z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv) 
     166                                          z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 
     167                                          z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 
    169168                                       END DO 
    170169                                    END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90

    r5836 r5845  
    5252 
    5353   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5554#  include "vectopt_loop_substitute.h90" 
    5655#  include "zdfddm_substitute.h90" 
     
    9291               DO jj = 1, jpj 
    9392                  DO ji = 1, jpi         
    94                      zvm = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     93                     zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    9594                     zvt = ptrdx(ji,jj,jk) * zvm 
    9695                     zvs = ptrdy(ji,jj,jk) * zvm 
     
    126125                  DO ji = 1, jpim1 
    127126                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    128                         &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * fse3u(ji,jj,jk) 
     127                        &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * e3u_n(ji,jj,jk) 
    129128                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    130                         &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * fse3u(ji,jj,jk) 
     129                        &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk) 
    131130                     umo(ktrd) = umo(ktrd) + zvt 
    132131                     vmo(ktrd) = vmo(ktrd) + zvs 
     
    143142                        &                       * z1_2rau0 * e1u    (ji  ,jj  ) * e2u    (ji,jj) 
    144143                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    145                         &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * fse3u(ji,jj,jk) 
     144                        &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk) 
    146145                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    147146                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
     
    225224            DO jj = 1, jpjm1 
    226225               DO ji = 1, jpim1 
    227                   zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    228                   zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     226                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     227                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    229228               END DO 
    230229            END DO 
     
    237236                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    238237                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
    239                      &              / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     238                     &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    240239               END DO 
    241240            END DO 
     
    246245         peke = 0._wp 
    247246         DO jk = 1, jpkm1 
    248             peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     247            peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 
    249248         END DO 
    250249         peke = grav * peke 
     
    530529      tvolt = 0._wp 
    531530      DO jk = 1, jpkm1 
    532          tvolt = tvolt + SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     531         tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
    533532      END DO 
    534533      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
     
    547546         DO jj = 2, jpjm1 
    548547            DO ji = fs_2, fs_jpim1   ! vector opt. 
    549                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    550                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
     548               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     549               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    551550            END DO 
    552551         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r5215 r5845  
    2626 
    2727   !! * Substitutions 
    28 #  include "domzgr_substitute.h90" 
    2928#  include "vectopt_loop_substitute.h90" 
    3029   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5836 r5845  
    4141 
    4242   !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4443#  include "vectopt_loop_substitute.h90" 
    4544   !!---------------------------------------------------------------------- 
     
    9796         nkstp = kt 
    9897         DO jk = 1, jpkm1 
    99             bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
    100             bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    101             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk) 
     98            bu   (:,:,jk) =           e1e2u(:,:) * e3u_n(:,:,jk) 
     99            bv   (:,:,jk) =           e1e2v(:,:) * e3v_n(:,:,jk) 
     100            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) * tmask(:,:,jk) 
    102101         END DO 
    103102      ENDIF 
     
    172171!                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    173172!                  ikbv = mbkv(ji,jj) 
    174 !                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu) 
    175 !                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv) 
     173!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 
     174!                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 
    176175!               END DO 
    177176!            END DO 
     
    227226       
    228227      !  Surface value (also valid in partial step case) 
    229       zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * fse3w(:,:,1) 
     228      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1) 
    230229 
    231230      ! interior value (2=<jk=<jpkm1) 
    232231      DO jk = 2, jpk 
    233          zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * fse3w(:,:,jk) 
     232         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk) 
    234233      END DO 
    235234 
     
    238237         DO jj = 1, jpj 
    239238            DO ji = 1, jpi 
    240                zcoef = 0.5_wp / fse3t(ji,jj,jk) 
     239               zcoef = 0.5_wp / e3t_n(ji,jj,jk) 
    241240               pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 
    242241            END DO 
     
    271270      IF( .NOT.lk_vvl ) THEN      ! constant volume: bu, bv, 1/bt computed one for all 
    272271         DO jk = 1, jpkm1 
    273             bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
    274             bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    275             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) 
     272            bu   (:,:,jk) =           e1e2u(:,:) * e3u_n(:,:,jk) 
     273            bv   (:,:,jk) =           e1e2v(:,:) * e3v_n(:,:,jk) 
     274            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) 
    276275         END DO 
    277276      ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r5836 r5845  
    5050   INTEGER ::   nkstp       ! current time step  
    5151 
    52  
    53  
    5452!!gm  to be moved from trdmxl_oce 
    5553!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   hml                ! ML depth (sum of e3t over nmln-1 levels) [m]  
     
    7371 
    7472   !! * Substitutions 
    75 #  include "domzgr_substitute.h90" 
    7673#  include "zdfddm_substitute.h90" 
    7774   !!---------------------------------------------------------------------- 
     
    126123            DO jj = 1,jpj 
    127124               DO ji = 1,jpi 
    128                   IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     125                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    129126               END DO 
    130127            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r5836 r5845  
    3737 
    3838   !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4039#  include "zdfddm_substitute.h90" 
    4140#  include "vectopt_loop_substitute.h90" 
     
    102101                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
    103102                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
    104                                      & ) / fse3t(:,:,1) 
     103                                     & ) / e3t_n(:,:,1) 
    105104                                   CALL iom_put( "petrd_sad" , z2d ) 
    106105                                   CALL wrk_dealloc( jpi, jpj, z2d ) 
     
    120119                                !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 & 
    121120                                !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    & 
    122                                 !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt ) 
     121                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt ) 
    123122                                !   CALL iom_put( "petrd_sad" , z2d ) 
    124123                                !   CALL wrk_dealloc( jpi, jpj, z2d ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r5836 r5845  
    4343 
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "zdfddm_substitute.h90" 
    4746#  include "vectopt_loop_substitute.h90" 
     
    130129            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    131130            DO jk = 2, jpk 
    132                zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    133                zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     131               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     132               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    134133            END DO 
    135134            ! 
    136135            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    137136            DO jk = 1, jpkm1 
    138                ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
    139                ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
     137               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 
     138               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk)  
    140139            END DO 
    141140            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     
    207206               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    208207                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
    209                  &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk) 
     208                 &              / ( e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) )  * tmask(ji,jj,jk) 
    210209            END DO 
    211210         END DO 
     
    308307                               IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
    309308                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
    310                                   z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
    311                                   z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
     309                                  z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
     310                                  z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
    312311                                  CALL iom_put( "ttrd_sad", z2dx ) 
    313312                                  CALL iom_put( "strd_sad", z2dy ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r5836 r5845  
    5757 
    5858   !! * Substitutions 
    59 #  include "domzgr_substitute.h90" 
    6059#  include "vectopt_loop_substitute.h90" 
    6160   !!---------------------------------------------------------------------- 
     
    109108         DO jj = 2, jpjm1                                                             ! wind stress trends 
    110109            DO ji = fs_2, fs_jpim1   ! vector opt. 
    111                ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 
    112                ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 
     110               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 
     111               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 
    113112            END DO 
    114113         END DO 
     
    183182               ikbu = mbkv(ji,jj) 
    184183               ikbv = mbkv(ji,jj)             
    185                zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 
    186                zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 
     184               zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 
     185               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 
    187186            END DO 
    188187         END DO 
    189188         ! 
    190189      CASE( jpvor_swf )        ! wind stress 
    191          zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
    192          zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
     190         zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1) 
     191         zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1) 
    193192         ! 
    194193      END SELECT 
    195194 
    196195      ! Average except for Beta.V 
    197       zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    198       zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
     196      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
     197      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
    199198    
    200199      ! Curl 
     
    270269      ! putrdvor and pvtrdvor terms 
    271270      DO jk = 1,jpk 
    272         zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk) 
    273         zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 
     271        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk) 
     272        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 
    274273      END DO 
    275274 
     
    286285         END DO 
    287286         ! Average of the Curl and Surface mask 
    288          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1) 
     287         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 
    289288      ENDIF 
    290289      ! 
    291290      ! Average  
    292       zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    293       zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
     291      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
     292      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
    294293      ! 
    295294      ! Curl 
     
    351350      ! Vertically averaged velocity 
    352351      DO jk = 1, jpk - 1 
    353          zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk) 
    354          zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk) 
     352         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk) 
     353         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk) 
    355354      END DO 
    356355  
    357       zun(:,:) = zun(:,:) * hur(:,:) 
    358       zvn(:,:) = zvn(:,:) * hvr(:,:) 
     356      zun(:,:) = zun(:,:) * r1_hu_n(:,:) 
     357      zvn(:,:) = zvn(:,:) * r1_hv_n(:,:) 
    359358 
    360359      ! Curl 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r5332 r5845  
    5656   !! * Substitutions 
    5757#  include "vectopt_loop_substitute.h90" 
    58 #  include "domzgr_substitute.h90" 
    5958   !!---------------------------------------------------------------------- 
    6059   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    117116                  ikbt = mbkt(ji,jj) 
    118117!! JC: possible WAD implementation should modify line below if layers vanish 
    119                   ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     118                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    120119                  zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 
    121120                  zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max) 
     
    128127                     ikbt = mikt(ji,jj) 
    129128! JC: possible WAD implementation should modify line below if layers vanish 
    130                      ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     129                     ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    131130                     ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
    132131                     ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) 
     
    375374               DO ji = 1, jpi 
    376375                  ikbt = mbkt(ji,jj) 
    377                   ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     376                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    378377                  bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 
    379378                  bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max) 
     
    384383                  DO ji = 1, jpi 
    385384                     ikbt = mikt(ji,jj) 
    386                      ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 
     385                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 
    387386                     tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
    388387                     tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) 
     
    424423             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points 
    425424             ikbv = mbkv(ji,jj) 
    426              zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 
    427              zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 
     425             zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt 
     426             zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt 
    428427             IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN 
    429428                IF( ln_ctl ) THEN 
     
    446445                ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points 
    447446                ikbv = mikv(ji,jj) 
    448                 zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 
    449                 zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 
     447                zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt 
     448                zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt 
    450449                IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 
    451450                   IF( ln_ctl ) THEN 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r5836 r5845  
    4444 
    4545   !! * Substitutions 
    46 #  include "domzgr_substitute.h90" 
    4746#  include "vectopt_loop_substitute.h90" 
    4847   !!---------------------------------------------------------------------- 
     
    115114         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
    116115            DO ji = 1, jpi 
    117                zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
    118                   &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     116               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     117                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )  
    119118               ! 
    120119               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  & 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r5836 r5845  
    2929   PUBLIC   zdf_evd    ! called by step.F90 
    3030 
    31    !! * Substitutions 
    32 #  include "domzgr_substitute.h90" 
    3331   !!---------------------------------------------------------------------- 
    3432   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r5836 r5845  
    102102 
    103103   !! * Substitutions 
    104 #  include "domzgr_substitute.h90" 
    105104#  include "vectopt_loop_substitute.h90" 
    106105   !!---------------------------------------------------------------------- 
     
    204203               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   & 
    205204                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
    206                   &                            / (  fse3uw_n(ji,jj,jk)               & 
    207                   &                            *    fse3uw_b(ji,jj,jk) ) 
     205                  &                            / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
    208206               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   & 
    209207                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   & 
    210                   &                            / (  fse3vw_n(ji,jj,jk)               & 
    211                   &                            *    fse3vw_b(ji,jj,jk) ) 
     208                  &                            / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
    212209               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk) 
    213210            END DO 
     
    226223            DO jj = 2, jpjm1  
    227224               DO ji = fs_2, fs_jpim1   ! vector opt. 
    228                   zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1) 
    229                   zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) ) 
     225                  zup   = mxln(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1) 
     226                  zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ) 
    230227                  zcoef = ( zup / MAX( zdown, rsmall ) ) 
    231228                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) 
     
    284281               ! lower diagonal 
    285282               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   & 
    286                   &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
     283                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) ) 
    287284               ! 
    288285               ! upper diagonal 
    289286               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   & 
    290                   &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) ) 
     287                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    291288               ! 
    292289               ! diagonal 
     
    320317      !  
    321318      ! One level below 
    322       en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) & 
     319      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 
    323320         &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 
    324321      en(:,:,2) = MAX(en(:,:,2), rn_emin ) 
     
    341338      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b 
    342339      z_elem_a(:,:,2) = 0._wp 
    343       zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) )) 
     340      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 
    344341      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) & 
    345           &                       * ((zhsro(:,:)+fsdept(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf) 
    346  
    347       en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2) 
     342          &                       * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf) 
     343 
     344      en(:,:,2) = en(:,:,2) + zflxs(:,:)/e3w_n(:,:,2) 
    348345      ! 
    349346      ! 
     
    508505               ! lower diagonal 
    509506               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   & 
    510                   &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
     507                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) ) 
    511508               ! upper diagonal 
    512509               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   & 
    513                   &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) ) 
     510                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    514511               ! diagonal 
    515512               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  & 
     
    539536      ! 
    540537      ! One level below 
    541       zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdepw(:,:,2)/zhsro(:,:) ))) 
    542       zdep(:,:)       = (zhsro(:,:) + fsdepw(:,:,2)) * zkar(:,:) 
     538      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) ))) 
     539      zdep(:,:)       = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:) 
    543540      psi (:,:,2)     = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    544541      z_elem_a(:,:,2) = 0._wp 
     
    561558      ! 
    562559      ! Set psi vertical flux at the surface: 
    563       zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 
    564       zdep(:,:) = ((zhsro(:,:) + fsdept(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 
     560      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 
     561      zdep(:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 
    565562      zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    566563      zdep(:,:) =  rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * & 
    567              & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + fsdept(:,:,1))**(rnn-1.) 
     564             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) 
    568565      zflxs(:,:) = zdep(:,:) * zflxs(:,:) 
    569       psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2) 
     566      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2) 
    570567 
    571568      !    
     
    593590               ! 
    594591               ! Just above last level, Dirichlet condition again (GOTM like) 
    595                zdep(ji,jj) = vkarmn * ( rn_bfrz0 + fse3t(ji,jj,ibotm1) ) 
     592               zdep(ji,jj) = vkarmn * ( rn_bfrz0 + e3t_n(ji,jj,ibotm1) ) 
    596593               psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn 
    597594               z_elem_a(ji,jj,ibotm1) = 0._wp 
     
    621618               ! 
    622619               ! Set psi vertical flux at the bottom: 
    623                zdep(ji,jj) = rn_bfrz0 + 0.5_wp*fse3t(ji,jj,ibotm1) 
     620               zdep(ji,jj) = rn_bfrz0 + 0.5_wp*e3t_n(ji,jj,ibotm1) 
    624621               zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   & 
    625622                  &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 
    626                psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1) 
     623               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1) 
    627624            END DO 
    628625         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r4990 r5845  
    3636   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3737 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4038   !!---------------------------------------------------------------------- 
    4139   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    105103            DO ji = 1, jpi 
    106104               ikt = mbkt(ji,jj) 
    107                hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk) 
     105               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 
    108106               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    109107            END DO 
     
    127125            iikn = nmln(ji,jj) 
    128126            imkt = mikt(ji,jj) 
    129             hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! Turbocline depth  
    130             hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth 
    131             hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     127            hmld (ji,jj) = ( gdepw_n(ji,jj,iiki  ) - gdepw_n(ji,jj,imkt )            )   * ssmask(ji,jj)    ! Turbocline depth  
     128            hmlp (ji,jj) = ( gdepw_n(ji,jj,iikn  ) - gdepw_n(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth 
     129            hmlpt(ji,jj) = ( gdept_n(ji,jj,iikn-1) - gdepw_n(ji,jj,imkt )            )   * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    132130         END DO 
    133131      END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r5836 r5845  
    5555 
    5656   !! * Substitutions 
    57 #  include "domzgr_substitute.h90" 
     57#  include "vectopt_loop_substitute.h90" 
    5858   !!---------------------------------------------------------------------- 
    5959   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    133133         ! ----------------- 
    134134         DO jj = 2, jpjm1 
    135             DO ji = 2, jpim1 
    136                zcoef = 0.5 / fse3w(ji,jj,jk) 
     135            DO ji = fs_2, fs_jpim1 
     136               zcoef = 0.5 / e3w_n(ji,jj,jk) 
    137137               !                                            ! shear of horizontal velocity 
    138138               zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   & 
     
    151151         z05alp = 0.5_wp * rn_alp 
    152152         DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm) 
    153             DO ji = 1, jpim1 
     153            DO ji = 1, fs_jpim1 
    154154               avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric 
    155155               avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric 
     
    157157         END DO 
    158158         DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt) 
    159             DO ji = 2, jpim1 
     159            DO ji = fs_2, fs_jpim1 
    160160               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           & 
    161161                  &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      & 
     
    176176      ! ------------------------------------------------------- 
    177177      zflageos = ( 0.5 + SIGN( 0.5, nn_eos - 1. ) ) * rau0 
    178       DO jj = 1, jpj 
    179          DO ji = 1, jpi 
     178      DO jj = 2, jpjm1 
     179            DO ji = fs_2, fs_jpim1 
    180180            zrhos          = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) ) 
    181181            zustar         = SQRT( taum(ji,jj) / ( zrhos +  rsmall ) ) 
     
    189189      ! are always equal to the namelist values rn_wtmix/rn_wvmix 
    190190      ! ------------------------------------------------------- 
    191       DO jj = 1, jpj 
    192          DO ji = 1, jpi 
     191      DO jj = 2, jpjm1 
     192         DO ji = fs_2, fs_jpim1 
    193193            avmv(ji,jj,1) = MAX( avmv(ji,jj,1), rn_wvmix ) 
    194194            avmu(ji,jj,1) = MAX( avmu(ji,jj,1), rn_wvmix ) 
     
    200200      ! ------------------------------------------------------- 
    201201      DO jk = 2, jpkm1 
    202          DO jj = 1, jpj 
    203             DO ji = 1, jpi 
     202         DO jj = 2, jpjm1 
     203            DO ji = fs_2, fs_jpim1 
    204204               IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 
    205205                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 
     
    212212 
    213213      DO jk = 1, jpkm1                 
    214          DO jj = 1, jpj 
    215             DO ji = 1, jpi 
     214         DO jj = 2, jpjm1 
     215            DO ji = fs_2, fs_jpim1 
    216216               avmv(ji,jj,jk) = avmv(ji,jj,jk) * vmask(ji,jj,jk) 
    217217               avmu(ji,jj,jk) = avmu(ji,jj,jk) * umask(ji,jj,jk) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r5836 r5845  
    9999 
    100100   !! * Substitutions 
    101 #  include "domzgr_substitute.h90" 
    102101#  include "vectopt_loop_substitute.h90" 
    103102   !!---------------------------------------------------------------------- 
     
    294293         ! 
    295294         !                        !* total energy produce by LC : cumulative sum over jk 
    296          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 
     295         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 
    297296         DO jk = 2, jpk 
    298             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 
     297            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 
    299298         END DO 
    300299         !                        !* finite Langmuir Circulation depth 
     
    312311         DO jj = 1, jpj  
    313312            DO ji = 1, jpi 
    314                zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 
     313               zhlc(ji,jj) = gdepw_n(ji,jj,imlc(ji,jj)) 
    315314            END DO 
    316315         END DO 
     
    321320                  zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    322321                  !                                           ! vertical velocity due to LC 
    323                   zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) ) 
    324                   zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
     322                  zind = 0.5 - SIGN( 0.5, gdepw_n(ji,jj,jk) - zhlc(ji,jj) ) 
     323                  zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) ) 
    325324                  !                                           ! TKE Langmuir circulation source term 
    326325                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     
    344343                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   & 
    345344                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) & 
    346                   &                 / (  fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) ) 
     345                  &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
    347346               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   & 
    348347                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   & 
    349348                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) & 
    350                   &                 / (  fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 
     349                  &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
    351350            END DO 
    352351         END DO 
     
    377376               zcof   = zfact1 * tmask(ji,jj,jk) 
    378377               zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal 
    379                   &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) ) 
     378                  &          / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  ) ) 
    380379               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal 
    381                   &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
     380                  &          / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) ) 
    382381               !                                   ! shear prod. at w-point weightened by mask 
    383382               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
     
    438437      !                            !  TKE due to surface and internal wave breaking 
    439438      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     439!!gm BUG : in the exp  remove the depth of ssh !!! 
     440       
     441       
    440442      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    441443         DO jk = 2, jpkm1 
    442444            DO jj = 2, jpjm1 
    443445               DO ji = fs_2, fs_jpim1   ! vector opt. 
    444                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     446                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    445447                     &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    446448               END DO 
     
    451453            DO ji = fs_2, fs_jpim1   ! vector opt. 
    452454               jk = nmln(ji,jj) 
    453                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     455               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    454456                  &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    455457            END DO 
     
    464466                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
    465467                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    466                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     468                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    467469                     &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    468470               END DO 
     
    570572            DO jj = 2, jpjm1 
    571573               DO ji = fs_2, fs_jpim1   ! vector opt. 
    572                   zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   & 
    573                   &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) ) 
     574                  zemxl = MIN( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   & 
     575                  &            gdepw_n(ji,jj,mbkt(ji,jj)+1) - gdepw_n(ji,jj,jk) ) 
    574576                  ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 
    575                   zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 
    576                   zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 
     577                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 
     578                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 
    577579               END DO 
    578580            END DO 
     
    583585            DO jj = 2, jpjm1 
    584586               DO ji = fs_2, fs_jpim1   ! vector opt. 
    585                   zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) ) 
     587                  zemxl = MIN( e3w_n(ji,jj,jk), zmxlm(ji,jj,jk) ) 
    586588                  zmxlm(ji,jj,jk) = zemxl 
    587589                  zmxld(ji,jj,jk) = zemxl 
     
    594596            DO jj = 2, jpjm1 
    595597               DO ji = fs_2, fs_jpim1   ! vector opt. 
    596                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
     598                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    597599               END DO 
    598600            END DO 
     
    601603            DO jj = 2, jpjm1 
    602604               DO ji = fs_2, fs_jpim1   ! vector opt. 
    603                   zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
     605                  zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    604606                  zmxlm(ji,jj,jk) = zemxl 
    605607                  zmxld(ji,jj,jk) = zemxl 
     
    612614            DO jj = 2, jpjm1 
    613615               DO ji = fs_2, fs_jpim1   ! vector opt. 
    614                   zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
     616                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    615617               END DO 
    616618            END DO 
     
    619621            DO jj = 2, jpjm1 
    620622               DO ji = fs_2, fs_jpim1   ! vector opt. 
    621                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
     623                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    622624               END DO 
    623625            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r5836 r5845  
    5151 
    5252   !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5453#  include "vectopt_loop_substitute.h90" 
    5554   !!---------------------------------------------------------------------- 
     
    126125      zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column 
    127126      DO jk = 2, jpkm1 
    128          zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
     127         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    129128      END DO 
    130129 
     
    144143            DO jj= 1, jpj 
    145144               DO ji= 1, jpi 
    146                   ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)                  & 
     145                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj)                  & 
    147146                     &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    148147               END DO 
     
    238237      zsum2(:,:) = 0.e0 
    239238      DO jk= 2, jpk 
    240          zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk) 
    241          zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)                
     239         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 
     240         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)                
    242241      END DO 
    243242      DO jj = 1, jpj 
     
    256255               ! 
    257256               zempba_3d(ji,jj,jk) =               ztpc  
    258                zsum     (ji,jj)    = zsum(ji,jj) + ztpc * fse3w(ji,jj,jk) 
     257               zsum     (ji,jj)    = zsum(ji,jj) + ztpc * e3w_n(ji,jj,jk) 
    259258            END DO 
    260259         END DO 
     
    275274      zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column 
    276275      DO jk = 2, jpkm1 
    277          zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
     276         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
    278277      END DO 
    279278 
     
    293292            DO jj= 1, jpj 
    294293               DO ji= 1, jpi 
    295                   ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
     294                  ztpc = ztpc + e1e2t(ji,jj) * e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
    296295                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    297296               END DO 
     
    447446            DO jj = 1, jpj 
    448447               DO ji = 1, jpi 
    449                   ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     448                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    450449               END DO 
    451450            END DO 
     
    461460         zkz(:,:) = 0._wp 
    462461         DO jk = 2, jpkm1 
    463                zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
     462               zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    464463         END DO 
    465464         ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 
     
    489488            DO jj = 1, jpj 
    490489               DO ji = 1, jpi 
    491                   ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     490                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    492491               END DO 
    493492            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5836 r5845  
    4141   PUBLIC   stp   ! called by nemogcm.F90 
    4242 
    43    !! * Substitutions 
    44 #  include "domzgr_substitute.h90" 
    45 !!gm   #  include "zdfddm_substitute.h90" 
    4643   !!---------------------------------------------------------------------- 
    4744   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     
    192189            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    193190!!gm 
    194                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
     191                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 
    195192                             
    196193            IF( ln_zps .AND. .NOT. ln_isfcav)   &                           ! Partial steps: bottom before horizontal gradient 
     
    275272            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
    276273!!gm 
    277                              CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
     274                             CALL eos    ( tsa, rhd, rhop, gdept_n(:,:,:) )   ! Time-filtered in situ density for hpg computation 
    278275            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    279                &             CALL zps_hde    ( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
     276               &             CALL zps_hde    ( kstp, jpts, tsa, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    280277               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    281278            IF( ln_zps .AND.       ln_isfcav)                                & 
     
    288285            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
    289286!!gm 
    290                              CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
     287                             CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation 
    291288         IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 
    292289               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: bottom before horizontal gradient 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r5385 r5845  
    6565#endif 
    6666 
    67    !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6967   !!---------------------------------------------------------------------- 
    7068   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    104102      !!---------------------------------------------------------------------- 
    105103      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient 
    106       !! 
     104      ! 
    107105      INTEGER  ::   jc     ! dummy loop indice 
    108106      INTEGER  ::   irgb   ! temporary integer 
     
    188186         zchl = zrgb(1,jc) 
    189187         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 
    190          IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb 
     188         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb 
    191189         IF( irgb /= jc ) THEN 
    192190            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb 
     
    210208      !!---------------------------------------------------------------------- 
    211209      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient 
    212       !! 
     210      ! 
    213211      INTEGER  ::   jc, jb ! dummy loop indice 
    214212      INTEGER  ::   irgb   ! temporary integer 
     
    262260      REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction 
    263261      REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates  
    264       !! 
     262      ! 
    265263      INTEGER  ::   jk, pjl            ! levels 
    266264      REAL(wp) ::   zhext              ! deepest level till which light penetrates 
     
    276274      DO jk = jpkm1, 1, -1 
    277275         IF(SUM(tmask(:,:,jk)) > 0 ) THEN 
    278             zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
     276            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) ) 
    279277            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
    280278         ELSE 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    r5836 r5845  
    6262 
    6363   !! * Substitutions 
    64 #  include "zdfddm_substitute.h90" 
    65 #  include "domzgr_substitute.h90" 
    6664#  include "vectopt_loop_substitute.h90" 
    6765   !!---------------------------------------------------------------------- 
     
    107105      !! ** Method  :  use iom_put 
    108106      !!---------------------------------------------------------------------- 
    109       !! 
    110107      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    111108      !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5510 r5845  
    1616   USE oce              ! ocean dynamics and tracers variables 
    1717   USE dom_oce          ! ocean space and time domain variables  
    18    USE in_out_manager   ! I/O manager 
    1918   USE sbc_oce 
    2019   USE sbccpl 
     20   USE daymod           ! calendar                         (day     routine) 
     21   USE sbcmod           ! surface boundary condition       (sbc     routine) 
     22   USE sbcrnf           ! surface boundary condition: runoff variables 
     23   USE eosbn2           ! equation of state                (eos_bn2 routine) 
     24   USE diawri           ! Standard run outputs             (dia_wri routine) 
     25   USE bdy_par          ! clem: mandatory for LIM3 
     26#if defined key_bdy 
     27   USE bdydta           ! clem: mandatory for LIM3 
     28#endif 
     29   USE stpctl           ! time stepping control            (stp_ctl routine) 
     30   USE prtctl           ! Print control                    (prt_ctl routine) 
     31   ! 
     32   USE in_out_manager   ! I/O manager 
     33   USE timing           ! Timing             
    2134   USE iom              ! 
    2235   USE lbclnk 
     
    2538#endif 
    2639 
    27    USE daymod           ! calendar                         (day     routine) 
    28  
    29    USE sbcmod           ! surface boundary condition       (sbc     routine) 
    30    USE sbcrnf           ! surface boundary condition: runoff variables 
    31  
    32    USE eosbn2           ! equation of state                (eos_bn2 routine) 
    33  
    34    USE diawri           ! Standard run outputs             (dia_wri routine) 
    35    USE stpctl           ! time stepping control            (stp_ctl routine) 
    36    USE prtctl           ! Print control                    (prt_ctl routine) 
    37  
    38    USE timing           ! Timing             
    39  
    40    USE bdy_par          ! clem: mandatory for LIM3 
    41 #if defined key_bdy 
    42    USE bdydta           ! clem: mandatory for LIM3 
    43 #endif 
    44  
    4540   IMPLICIT NONE 
    4641   PRIVATE 
    4742 
    48    PUBLIC   stp   ! called by opa.F90 
     43   PUBLIC   stp   ! called by nemogcm.F90 
    4944 
    50    !! * Substitutions 
    51 #  include "domzgr_substitute.h90" 
    52 #  include "zdfddm_substitute.h90" 
    5345   !!---------------------------------------------------------------------- 
    5446   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r5836 r5845  
    4949   REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm 
    5050 
    51    !! * Substitutions 
    52 #  include "domzgr_substitute.h90" 
    5351   !!---------------------------------------------------------------------- 
    5452   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    257255                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 
    258256            ! Add the surface flux to the trend 
    259             tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)  
     257            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1)  
    260258             
    261259            ! cumulation of surface flux at each time step 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r5836 r5845  
    5050   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    5151 
    52    !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    167165                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    168166               ! Add the surface flux to the trend 
    169                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)  
     167               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
    170168 
    171169               ! cumulation of surface flux at each time step 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5836 r5845  
    6060 
    6161   !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6362#  include "vectopt_loop_substitute.h90" 
    6463   !!---------------------------------------------------------------------- 
     
    6766   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6867   !!---------------------------------------------------------------------- 
    69  
    7068CONTAINS 
    7169 
     
    187185               !    closure : flux grazing is redistributed below level jpkbio 
    188186               zzoobod = tmminz * zzoo * zzoo 
    189                xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 
     187               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 
    190188               zboddet = fdbod * zzoobod 
    191189 
     
    242240                IF( ln_diatrc .OR. lk_iomput ) THEN 
    243241                  ! convert fluxes in per day 
    244                   ze3t = fse3t(ji,jj,jk) * 86400. 
     242                  ze3t = e3t_n(ji,jj,jk) * 86400. 
    245243                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    246244                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     
    363361                IF( ln_diatrc .OR. lk_iomput ) THEN 
    364362                  ! convert fluxes in per day 
    365                   ze3t = fse3t(ji,jj,jk) * 86400. 
     363                  ze3t = e3t_n(ji,jj,jk) * 86400. 
    366364                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    367365                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r5836 r5845  
    4242 
    4343   !! * Substitutions 
    44 #  include "domzgr_substitute.h90" 
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
     
    9594         DO jj = 2, jpjm1 
    9695            DO ji = fs_2, fs_jpim1 
    97                ze3t = 1. / fse3t(ji,jj,jk) 
     96               ze3t = 1. / e3t_n(ji,jj,jk) 
    9897               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    9998            END DO 
     
    110109         DO ji = fs_2, fs_jpim1 
    111110            ikt = mbkt(ji,jj)  
    112             tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt)  
     111            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt)  
    113112            ! Deposition of organic matter in the sediment 
    114113            zwork = vsed * trn(ji,jj,ikt,jpdet) 
     
    121120      DO jj = 2, jpjm1 
    122121         DO ji = fs_2, fs_jpim1 
    123             tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 
     122            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 
    124123         END DO 
    125124      END DO 
     
    212211         DO jj = 1, jpj 
    213212            DO ji = 1, jpi 
    214                zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr 
    215                zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
     213               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr 
     214               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 
    216215               IF( zfluo.GT.1. )   zfluo = 1._wp 
    217216               zdm0(ji,jj,jk) = zfluo - zfluu 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r5836 r5845  
    4040   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    4141 
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    4543   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    4745   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4846   !!---------------------------------------------------------------------- 
    49  
    5047CONTAINS 
    5148 
     
    105102               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    106103               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    107                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 
    108                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 
     104               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 
     105               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 
    109106            END DO 
    110107        END DO 
     
    116113               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    117114               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    118                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
    119                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 
     115               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 
     116               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 
    120117               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    121118            END DO 
     
    138135      DO jj = 1, jpj 
    139136         DO ji = 1, jpi 
    140             heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj)) 
     137            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 
    141138         END DO 
    142139      END DO  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r5836 r5845  
    3434   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile 
    3535 
    36    !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    102100         DO jj = 1, jpj 
    103101            DO ji = 1, jpi 
    104                ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     102               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    105103               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)  
    106104            END DO 
     
    111109         IF( iom_use( "TDETSED" ) ) THEN 
    112110            CALL wrk_alloc( jpi, jpj, zw2d ) 
    113             zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400. 
     111            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400. 
    114112            DO jk = 2, jpkm1 
    115                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400. 
     113               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 
    116114            END DO 
    117115            CALL iom_put( "TDETSED", zw2d ) 
     
    121119         IF( ln_diatrc ) THEN  
    122120            CALL wrk_alloc( jpi, jpj, zw2d ) 
    123             zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400. 
     121            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400. 
    124122            DO jk = 2, jpkm1 
    125                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400. 
     123               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 
    126124            END DO 
    127125            trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r5836 r5845  
    3434   PUBLIC  p4z_bio     
    3535 
    36    !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    7068         DO jj = 1, jpj 
    7169            DO ji = 1, jpi 
    72                IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     70!!gm  :  use nmln  and test on jk ...  less memory acces 
     71               IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
    7372            END DO  
    7473         END DO 
    7574      END DO 
    7675 
    77            
    7876      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column 
    7977      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r5836 r5845  
    164164   REAL(wp) :: devk55  = 0.3692E-3       
    165165 
    166    !! * Substitutions 
    167 #  include "domzgr_substitute.h90" 
    168166   !!---------------------------------------------------------------------- 
    169167   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    244242 
    245243 
    246  
    247244      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    248245      ! ------------------------------- 
     
    252249 
    253250               ! SET PRESSION 
    254                zpres   = 1.025e-1 * fsdept(ji,jj,jk) 
     251               zpres   = 1.025e-1 * gdept_n(ji,jj,jk) 
    255252 
    256253               ! SET ABSOLUTE TEMPERATURE 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r5836 r5845  
    3030   PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90 
    3131 
    32    !! * Shared module variables 
    33    LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
    34    LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
    35    REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron  
    36    REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust  
    37    REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean  
    38  
     32   LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
     33   LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
     34   REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron  
     35   REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust  
     36   REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean  
     37 
     38!!gm Not DOCTOR norm !!! 
    3939   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4040 
    41    !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4341   !!---------------------------------------------------------------------- 
    4442   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    6159      !!                    and one particulate form (ln_fechem) 
    6260      !!--------------------------------------------------------------------- 
    63       ! 
    64       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     61      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    6562      ! 
    6663      INTEGER  ::   ji, jj, jk, jic 
     64      CHARACTER (len=25) :: charout 
    6765      REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac 
    6866      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll 
     
    7977      REAL(wp) :: ztfe, zoxy 
    8078      REAL(wp) :: zstep 
    81       CHARACTER (len=25) :: charout 
    8279      !!--------------------------------------------------------------------- 
    8380      ! 
    8481      IF( nn_timing == 1 )  CALL timing_start('p4z_fechem') 
    8582      ! 
    86       ! Allocate temporary workspace 
    87       CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 
     83      CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig ) 
    8884      zFe3 (:,:,:) = 0. 
    8985      zFeL1(:,:,:) = 0. 
    9086      zTL1 (:,:,:) = 0. 
    9187      IF( ln_fechem ) THEN 
    92          CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     88         CALL wrk_alloc( jpi,jpj,jpk,  zFe2, zFeL2, zTL2, zFeP ) 
    9389         zFe2 (:,:,:) = 0. 
    9490         zFeL2(:,:,:) = 0. 
     
    253249               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    254250               zlamfac = MIN( 1.  , zlamfac ) 
    255                zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 
     251!!gm very small BUG :  it is unlikely but possible that gdept_n = 0  ..... 
     252               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    256253               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
    257254               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r5836 r5845  
    5959   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    6060 
    61    !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6361   !!---------------------------------------------------------------------- 
    6462   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    182180            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    183181            ! compute the trend 
    184             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1) 
     182            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 
    185183 
    186184            ! Compute O2 flux  
     
    188186            zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    189187            zoflx(ji,jj) = zfld16 - zflu16 
    190             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1) 
     188            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
    191189         END DO 
    192190      END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5836 r5845  
    5151   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5252    
    53    !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5553   !!---------------------------------------------------------------------- 
    5654   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    10199               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    102100               !                                                          
    103                ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 
    104                ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 
    105                ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 
     101               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 
     102               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
     103               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
    106104            END DO 
    107105         END DO 
     
    162160                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    163161                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    164                  heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth 
     162                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    165163              ENDIF 
    166164           END DO 
     
    179177         DO jj = 1, jpj 
    180178            DO ji = 1, jpi 
    181                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    182                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation 
    183                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    184                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    185                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    186                   zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
     179               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     180                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
     181                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     182                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     183                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     184                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    187185               ENDIF 
    188186            END DO 
     
    196194         DO jj = 1, jpj 
    197195            DO ji = 1, jpi 
    198                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     196               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    199197                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    200198                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     
    260258            DO jj = 1, jpj 
    261259               DO ji = 1, jpi 
    262                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 
     260                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
    263261                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 
    264262                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5836 r5845  
    5454   REAL(wp) :: texcret2               !: 1 - excret2         
    5555 
    56    !! * Substitutions 
    57 #  include "domzgr_substitute.h90" 
    5856   !!---------------------------------------------------------------------- 
    5957   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    277275         DO jj = 1, jpj 
    278276            DO ji = 1, jpi 
    279                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     277               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    280278                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 
    281279                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 
     
    321319            DO jj = 1, jpj 
    322320               DO ji = 1, jpi 
    323                   IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     321                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    324322                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
    325323                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
     
    462460             zw2d(:,:) = 0. 
    463461             DO jk = 1, jpkm1 
    464                zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     462               zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    465463             ENDDO 
    466464             CALL iom_put( "INTPPPHY" , zw2d ) 
     
    468466             zw2d(:,:) = 0. 
    469467             DO jk = 1, jpkm1 
    470                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
     468                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    471469             ENDDO 
    472470             CALL iom_put( "INTPPPHY2" , zw2d ) 
     
    475473             zw2d(:,:) = 0. 
    476474             DO jk = 1, jpkm1 
    477                 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     475                zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    478476             ENDDO 
    479477             CALL iom_put( "INTPP" , zw2d ) 
     
    482480             zw2d(:,:) = 0. 
    483481             DO jk = 1, jpkm1 
    484                 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     482                zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    485483             ENDDO 
    486484             CALL iom_put( "INTPNEW" , zw2d ) 
     
    489487             zw2d(:,:) = 0. 
    490488             DO jk = 1, jpkm1 
    491                 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
     489                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
    492490             ENDDO 
    493491            CALL iom_put( "INTPBFE" , zw2d ) 
     
    496494             zw2d(:,:) = 0. 
    497495             DO jk = 1, jpkm1 
    498                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
     496                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
    499497             ENDDO 
    500498             CALL iom_put( "INTPBSI" , zw2d ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r5836 r5845  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5151 
    52    !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    103101            DO ji = 1, jpi 
    104102               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    105                IF( fsdept(ji,jj,jk) < zdep ) THEN 
     103               IF( gdept_n(ji,jj,jk) < zdep ) THEN 
    106104                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
    107105                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    108106               ELSE 
    109                   zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) ) 
     107                  zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 
    110108                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
    111109                  zdepprod(ji,jj,jk) = zdepmin**0.273 
     
    283281               ! ---------------------------------------------------------- 
    284282               zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
    285                zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep ) 
     283               zdep     = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 
    286284               ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. ) 
    287285               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5836 r5845  
    2525   PUBLIC   p4z_sbc_init    
    2626 
    27    !! * Shared module variables 
    2827   LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere 
    2928   LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron 
     
    4544   LOGICAL , PUBLIC  :: ll_sbc 
    4645 
    47    !! * Module variables 
    4846   LOGICAL  ::  ll_solub 
    4947 
     
    8078   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 
    8179 
    82  
    8380   !! * Substitutions 
    84 #  include "domzgr_substitute.h90" 
    8581#  include "vectopt_loop_substitute.h90" 
    8682   !!---------------------------------------------------------------------- 
     
    8985   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9086   !!---------------------------------------------------------------------- 
    91  
    9287CONTAINS 
    9388 
     
    163158            DO jj = 1, jpj 
    164159               DO ji = 1, jpi 
    165                   nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 
     160                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn ) 
    166161               END DO 
    167162            END DO 
     
    267262      IF( lk_offline ) THEN 
    268263        nk_rnf(:,:) = 1 
    269         h_rnf (:,:) = fsdept(:,:,1) 
     264        h_rnf (:,:) = gdept_n(:,:,1) 
    270265      ENDIF 
    271266 
     
    456451            DO jj = 1, jpj 
    457452               DO ji = 1, jpi 
    458                   zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
     453                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
    459454                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
    460455                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
     
    466461         ironsed(:,:,jpk) = 0._wp 
    467462         DO jk = 1, jpkm1 
    468             ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
     463            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday ) 
    469464         END DO 
    470465         DEALLOCATE( zcmask) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r5836 r5845  
    3232   PUBLIC   p4z_sed_alloc 
    3333  
    34  
    35    !! * Module variables 
    3634   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation  
    3735   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    3836   REAL(wp) :: r1_rday                  !: inverse of rday 
    3937 
    40    !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    4238   !!---------------------------------------------------------------------- 
    4339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    10096         DO jj = 1, jpj 
    10197            DO ji = 1, jpi 
    102                zdep    = rfact2 / fse3t(ji,jj,1) 
     98               zdep    = rfact2 / e3t_n(ji,jj,1) 
    10399               zwflux  = fmmflx(ji,jj) / 1000._wp 
    104100               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep 
     
    111107         !  
    112108         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
    113             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
     109            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
    114110         ! 
    115111         CALL wrk_dealloc( jpi, jpj, zironice ) 
     
    125121         !                                              ! Iron and Si deposition at the surface 
    126122         IF( ln_solub ) THEN 
    127             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     123            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    128124         ELSE 
    129             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     125            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    130126         ENDIF 
    131          zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1  
    132          zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r  
     127         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
     128         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
    133129         !                                              ! Iron solubilization of particles in the water column 
    134130         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    135131         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
    136132         DO jk = 2, jpkm1 
    137             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. ) 
     133            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
    138134         END DO 
    139135         !                                              ! Iron solubilization of particles in the water column 
     
    145141            IF( knt == nrdttrc ) THEN 
    146142                IF( iom_use( "Irondep" ) )   & 
    147                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
     143                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    148144                IF( iom_use( "pdust" ) )   & 
    149145                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
     
    151147         ELSE                                     
    152148            IF( ln_diatrc )  & 
    153               &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     149              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    154150         ENDIF 
    155151         CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep ) 
     
    206202         DO ji = 1, jpi 
    207203            ikt  = mbkt(ji,jj) 
    208             zdep = fse3t(ji,jj,ikt) / xstep 
     204            zdep = e3t_n(ji,jj,ikt) / xstep 
    209205            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    210206            zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) ) 
     
    230226              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    231227              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    232               zdep  = LOG10( fsdepw(ji,jj,ikt+1) ) 
     228              zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    233229              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    234230              &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     
    279275         DO ji = 1, jpi 
    280276            ikt  = mbkt(ji,jj) 
    281             zdep = xstep / fse3t(ji,jj,ikt)  
     277            zdep = xstep / e3t_n(ji,jj,ikt)  
    282278            zws4 = zwsbio4(ji,jj) * zdep 
    283279            zwsc = zwscal (ji,jj) * zdep 
     
    305301         DO ji = 1, jpi 
    306302            ikt  = mbkt(ji,jj) 
    307             zdep = xstep / fse3t(ji,jj,ikt)  
     303            zdep = xstep / e3t_n(ji,jj,ikt)  
    308304            zws4 = zwsbio4(ji,jj) * zdep 
    309305            zws3 = zwsbio3(ji,jj) * zdep 
     
    336332            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
    337333            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
    338             sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt) 
     334            sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    339335#endif 
    340336         END DO 
     
    388384               zwork1(:,:) = 0. 
    389385               DO jk = 1, jpkm1 
    390                  zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk) 
     386                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
    391387               ENDDO 
    392388               CALL iom_put( "INTNFIX" , zwork1 )  
     
    395391      ELSE 
    396392         IF( ln_diatrc )  & 
    397             &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     393            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    398394      ENDIF 
    399395      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5836 r5845  
    6565#endif 
    6666 
    67    !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6967   !!---------------------------------------------------------------------- 
    7068   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    108106            DO ji = 1,jpi 
    109107               zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
    110                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 
     108               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp 
    111109               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    112110            END DO 
     
    137135             DO ji = 1, jpi 
    138136                IF( tmask(ji,jj,jk) == 1) THEN 
    139                    zwsmax =  0.5 * fse3t(ji,jj,jk) / xstep 
     137                   zwsmax =  0.5 * e3t_n(ji,jj,jk) / xstep 
    140138                   iiter1 =  MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) ) 
    141139                   iiter2 =  MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) ) 
     
    156154            DO ji = 1, jpi 
    157155               IF( tmask(ji,jj,jk) == 1 ) THEN 
    158                  zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep 
     156                 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 
    159157                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 
    160158                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) 
     
    700698         zl = zmin 
    701699         zr = zmax 
    702          wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2 
     700         wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 
    703701         zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    704702         znum = zl - 1. 
     
    844842            DO jj = 1, jpj       
    845843               DO ji = 1, jpi     
    846                   zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
     844                  zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 
    847845                  zew   = zwsink2(ji,jj,jk+1) 
    848846                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
     
    858856            DO jj = 1,jpj 
    859857               DO ji = 1, jpi 
    860                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     858                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    861859                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 
    862860               END DO 
     
    869867         DO jj = 1,jpj 
    870868            DO ji = 1, jpi 
    871                zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     869               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    872870               ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
    873871            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r5836 r5845  
    2121   PUBLIC trc_wri_pisces  
    2222 
    23    !! * Substitutions 
    24 #  include "domzgr_substitute.h90" 
    25  
     23   !!---------------------------------------------------------------------- 
     24   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     25   !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $ 
     26   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    2628CONTAINS 
    2729 
     
    5759         zdic(:,:) = 0. 
    5860         DO jk = 1, jpkm1 
    59             zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * fse3t(:,:,jk) * tmask(:,:,jk) * 12. 
     61            zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
    6062         ENDDO 
    6163         CALL iom_put( 'INTDIC', zdic )      
     
    6466      IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
    6567         zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
    66          zdepo2min(:,:) = fsdepw(:,:,1)    * tmask(:,:,1) 
     68         zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
    6769         DO jk = 2, jpkm1 
    6870            DO jj = 1, jpj 
     
    7173                     IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
    7274                        zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
    73                         zdepo2min(ji,jj) = fsdepw(ji,jj,jk) 
     75                        zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
    7476                     ENDIF 
    7577                  ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5836 r5845  
    6262 
    6363   !! * Substitutions 
    64 #  include "domzgr_substitute.h90" 
    6564#  include "vectopt_loop_substitute.h90" 
    6665   !!---------------------------------------------------------------------- 
     
    109108      !                                               !==  effective transport  ==! 
    110109      DO jk = 1, jpkm1 
    111          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    112          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     110         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     111         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    113112         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    114113      END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5836 r5845  
    4343 
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
     
    8281      !!              - save the trends ('key_trdmxl_trc') 
    8382      !!---------------------------------------------------------------------- 
    84       !! 
    85       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    86       !! 
    87       INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices 
    88       REAL(wp) ::   ztra                 ! temporary scalars 
     83      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     84      ! 
     85      INTEGER  ::   ji, jj, jk, jn, jl   ! dummy loop indices 
    8986      CHARACTER (len=22) :: charout 
    9087      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
     
    105102            ! 
    106103            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    107                 
     104               ! 
    108105               jl = n_trc_index(jn)  
    109106               CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    110107               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    111  
     108               ! 
    112109               SELECT CASE ( nn_zdmp_tr ) 
    113110               ! 
     
    116113                     DO jj = 2, jpjm1 
    117114                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    118                            ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    119                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     115                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    120116                        END DO 
    121117                     END DO 
    122118                  END DO 
    123                ! 
     119                  ! 
    124120               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    125121                  DO jk = 1, jpkm1 
     
    127123                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    128124                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
    129                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    130                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     125                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    131126                           ENDIF 
    132127                        END DO 
    133128                     END DO 
    134129                  END DO 
    135                ! 
     130                  ! 
    136131               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    137132                  DO jk = 1, jpkm1 
    138133                     DO jj = 2, jpjm1 
    139134                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    140                            IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    141                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    142                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     135                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     136                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    143137                           END IF 
    144138                        END DO 
    145139                     END DO 
    146140                  END DO 
    147                 
     141                   
    148142               END SELECT 
    149143               !  
     
    162156      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    163157      !                                          ! print mean trends (used for debugging) 
    164       IF( ln_ctl )   THEN 
    165          WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout) 
    166                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     158      IF( ln_ctl ) THEN 
     159         WRITE(charout, FMT="('dmp ')") 
     160         CALL prt_ctl_trc_info(charout) 
     161         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    167162      ENDIF 
    168163      ! 
     
    170165      ! 
    171166   END SUBROUTINE trc_dmp 
     167 
    172168 
    173169   SUBROUTINE trc_dmp_ini 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5836 r5845  
    4747    
    4848   !! * Substitutions 
    49 #  include "domzgr_substitute.h90" 
    5049#  include "vectopt_loop_substitute.h90" 
    5150   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5836 r5845  
    3131 
    3232   !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
    3433#  include "vectopt_loop_substitute.h90" 
    3534   !!---------------------------------------------------------------------- 
     
    153152            DO jj = 2, jpj 
    154153               DO ji = fs_2, fs_jpim1   ! vector opt. 
    155                   zse3t = 1. / fse3t(ji,jj,1) 
     154                  zse3t = 1. / e3t_n(ji,jj,1) 
    156155                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    157156                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     
    174173         DO jj = 2, jpj 
    175174            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                zse3t = zfact / fse3t(ji,jj,1) 
     175               zse3t = zfact / e3t_n(ji,jj,1) 
    177176               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    178177            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5836 r5845  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "zdfddm_substitute.h90" 
    4443#  include "vectopt_loop_substitute.h90" 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r5836 r5845  
    6666 
    6767   !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6968#  include "zdfddm_substitute.h90" 
    7069   !!---------------------------------------------------------------------- 
     
    175174            DO jj = 1, jpj 
    176175               DO ji = 1, jpi 
    177                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     176                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    178177               END DO 
    179178            END DO 
     
    293292            DO jj = 1,jpj 
    294293              DO ji = 1,jpi 
    295                   IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     294                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    296295               END DO 
    297296            END DO 
     
    417416               DO jn = 1, jptra 
    418417                  IF( ln_trdtrc(jn) )    & 
    419                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
     418                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  & 
    420419                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    421420                       &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    r5341 r5845  
    2121   
    2222   INTEGER ::   nummldw_trc               ! logical unit for mld restart 
     23    
    2324   !!--------------------------------------------------------------------------------- 
    2425   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    2627   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2728   !!--------------------------------------------------------------------------------- 
    28    
    2929CONTAINS 
    30    
    3130 
    3231    SUBROUTINE trd_mxl_trc_rst_write( kt ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r5215 r5845  
    11MODULE trcbc 
    22   !!====================================================================== 
    3    !!                     ***  MODULE  trcdta  *** 
     3   !!                     ***  MODULE  trcbc  *** 
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
     
    4040   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read) 
    4141 
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    4543   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    5856      !!              - allocates passive tracer BC data structure  
    5957      !!---------------------------------------------------------------------- 
    60       ! 
    6158      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    6259      INTEGER            :: jl, jn                         ! dummy loop indices 
     
    242239         ! 
    243240      ENDIF 
    244   
     241      ! 
    245242      DEALLOCATE( slf_i )          ! deallocate local field structure 
    246243      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init') 
    247  
     244      ! 
    248245   END SUBROUTINE trc_bc_init 
    249246 
     
    258255      !!               
    259256      !!---------------------------------------------------------------------- 
    260     
    261       ! NEMO 
    262257      USE fldread 
    263        
    264       !! * Arguments 
     258      ! 
    265259      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
    267260      !!--------------------------------------------------------------------- 
    268261      ! 
     
    295288      ! 
    296289      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    297       !        
    298  
     290      ! 
    299291   END SUBROUTINE trc_bc_read 
     292 
    300293#else 
    301294   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5385 r5845  
    3636   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    3737!$AGRIF_END_DO_NOT_TREAT 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
     38 
    4039   !!---------------------------------------------------------------------- 
    4140   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    189188                  DO ji = 1, jpi 
    190189                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    191                         zl = fsdept_n(ji,jj,jk) 
     190                        zl = gdept_n(ji,jj,jk) 
    192191                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    193192                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1) 
     
    220219                        ik = mbkt(ji,jj)  
    221220                        IF( ik > 1 ) THEN 
    222                            zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     221                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    223222                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 
    224223                        ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5836 r5845  
    3232   PUBLIC   trc_init   ! called by opa 
    3333 
    34     !! * Substitutions 
    35 #  include "domzgr_substitute.h90" 
    3634   !!---------------------------------------------------------------------- 
    3735   !! NEMO/TOP 4.0 , NEMO Consortium (2011) 
     
    119117      !                                                              ! masked grid volume 
    120118      DO jk = 1, jpk 
    121          cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     119         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    122120      END DO 
    123       IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     121      IF( lk_degrad )   cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)    ! degrad option: reduction by facvol 
    124122      !                                                              ! total volume of the ocean  
    125123      areatot = glob_sum( cvol(:,:,:) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r5836 r5845  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !!   trc_rst :   Restart for passive tracer 
    17    !!---------------------------------------------------------------------- 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_top'                                                TOP models 
    20    !!---------------------------------------------------------------------- 
     16   !!   trc_rst        : Restart for passive tracer 
    2117   !!   trc_rst_opn    : open  restart file 
    2218   !!   trc_rst_read   : read  restart file 
     
    2723   USE iom 
    2824   USE daymod 
     25    
    2926   IMPLICIT NONE 
    3027   PRIVATE 
     
    3532   PUBLIC   trc_rst_cal 
    3633 
    37    !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    39     
     34   !!---------------------------------------------------------------------- 
     35   !! NEMO/TOP 3.7 , NEMO Consortium (2010) 
     36   !! $Id$ 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !!---------------------------------------------------------------------- 
    4039CONTAINS 
    4140    
     
    288287      ! 
    289288      DO jk = 1, jpk 
    290          zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk) 
     289         zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    291290      END DO 
    292291      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5407 r5845  
    3636   LOGICAL  :: llnew 
    3737 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4038   !!---------------------------------------------------------------------- 
    4139   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    6866      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution 
    6967         DO jk = 1, jpk 
    70             cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     68            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    7169         END DO 
    7270         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r5836 r5845  
    4040   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables 
    4141 
    42    !!* Module variables 
    4342   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc  
    4443   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)  
     
    4847   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean  
    4948 
    50    !! * Substitutions 
    51 #  include "domzgr_substitute.h90" 
    5249   !!---------------------------------------------------------------------- 
    5350   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    8885       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 
    8986          ! 
    90           un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:)  
    91           vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:)  
    92           tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    93           tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    94           rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)   
    95           avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)   
    96 # if defined key_zdfddm 
    97           avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
     87          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)  
     88          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)  
     89          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     90          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     91          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
     92          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
     93# if defined key_zdfddm 
     94          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    9895# endif 
    9996         IF( l_ldfslp ) THEN 
     
    165162         ! 
    166163         ! 2. Create averages and reassign variables 
    167          un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:)  
    168          vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:)  
    169          tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    170          tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    171          rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)   
    172          avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)   
    173 # if defined key_zdfddm 
    174          avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
     164         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)  
     165         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)  
     166         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     167         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     168         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
     169         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
     170# if defined key_zdfddm 
     171         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    175172# endif 
    176173         IF( l_ldfslp ) THEN 
     
    244241            DO jj = 1, jpj 
    245242               DO ji = 1, jpi 
    246                   z1_ne3t = r1_ndttrcp1  / fse3t(ji,jj,jk) 
    247                   z1_ne3u = r1_ndttrcp1  / fse3u(ji,jj,jk) 
    248                   z1_ne3v = r1_ndttrcp1  / fse3v(ji,jj,jk) 
    249                   z1_ne3w = r1_ndttrcp1  / fse3w(ji,jj,jk) 
     243                  z1_ne3t = r1_ndttrcp1  / e3t_n(ji,jj,jk) 
     244                  z1_ne3u = r1_ndttrcp1  / e3u_n(ji,jj,jk) 
     245                  z1_ne3v = r1_ndttrcp1  / e3v_n(ji,jj,jk) 
     246                  z1_ne3w = r1_ndttrcp1  / e3w_n(ji,jj,jk) 
    250247                  ! 
    251248                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u 
     
    300297      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 
    301298 
    302       un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    303       vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:)  
    304       tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    305       tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    306       rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
     299      un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:)  
     300      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:)  
     301      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     302      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     303      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
    307304!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    308       avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    309 # if defined key_zdfddm 
    310       avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
     305      avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
     306# if defined key_zdfddm 
     307      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    311308# endif 
    312309      IF( l_ldfslp ) THEN 
     
    400397      !                                       
    401398      ! Start new averages 
    402          un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    403          vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:)  
    404          tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    405          tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    406          rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
    407          avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    408 # if defined key_zdfddm 
    409          avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
     399         un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:)  
     400         vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:)  
     401         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     402         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     403         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
     404         avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
     405# if defined key_zdfddm 
     406         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    410407# endif 
    411408      IF( l_ldfslp ) THEN 
     
    495492      zhdiv(:,:) = 0._wp 
    496493      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    497         zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
     494        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
    498495      END DO 
    499496      !                                                ! Sea surface elevation time stepping 
     
    520517      z1_2dt = 1.e0 / z2dt 
    521518      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    522          ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 
    523          wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    524             &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
     519         ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise 
     520         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        & 
     521            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    & 
    525522            &                         * tmask(:,:,jk) * z1_2dt 
    526523#if defined key_bdy 
Note: See TracChangeset for help on using the changeset viewer.