Changeset 5845


Ignore:
Timestamp:
2015-10-31T08:40:45+01:00 (5 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(:,:,:) ),  &