Changeset 5758


Ignore:
Timestamp:
2015-09-24T08:31:40+02:00 (5 years ago)
Author:
gm
Message:

#1593: LDF-ADV, step II.1: phasing the improvements/simplifications of diffusive trend (see wiki)

Location:
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
Files:
2 added
13 deleted
43 edited
1 moved

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r5215 r5758  
    1818 
    1919   !!---------------------------------------------------------------------- 
    20    !!   'key_asminc' : Switch on the assimilation increment interface 
    21    !!---------------------------------------------------------------------- 
    2220   !!   asm_bkg_wri  : Write out the background state 
    2321   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var) 
     
    2725   USE zdf_oce            ! Vertical mixing variables 
    2826   USE zdfddm             ! Double diffusion mixing parameterization 
    29    USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory 
    30    USE ldfslp             ! Slopes of neutral surfaces 
     27   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients 
     28   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces 
    3129   USE tradmp             ! Tracer damping 
    3230#if defined key_zdftke 
     
    4139   USE asmpar             ! Parameters for the assmilation interface 
    4240   USE zdfmxl             ! mixed layer depth 
    43 #if defined key_traldf_c2d 
    44    USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine) 
    45 #endif 
    4641#if defined key_lim2 
    4742   USE ice_2 
     
    155150            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    156151#if defined key_lim2 || defined key_lim3 
    157             IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN 
    158           IF(ALLOCATED(frld)) THEN 
    159                   CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   ) 
     152            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN 
     153               IF( ALLOCATED(frld) ) THEN 
     154                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   ) 
    160155               ELSE 
    161         CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
    162           ENDIF 
     156                  CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
     157               ENDIF 
    163158            ENDIF 
    164159#endif 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r5412 r5758  
    8282      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz 
    8383      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    84       IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz 
    8584      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value) 
    8685         avt (:,:,:) = rn_avt0 * tmask(:,:,:) 
     
    9392      ENDIF 
    9493      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    95  
    9694      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
    97  
    98       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    99          &               CALL zdf_ddm( kstp )         ! double diffusive mixing 
    100           
     95      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing 
    10196                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    10297 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5217 r5758  
    1111   !!                       other variables needed to be passed to TOP 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers  
    14    USE dom_oce         ! ocean space and time domain 
    15    USE ldftra_oce      ! ocean active tracers: lateral physics 
    16    USE sbc_oce         ! Surface boundary condition: ocean fields 
    17    USE zdf_oce         ! vertical  physics: ocean fields 
    18    USE zdfddm          ! vertical  physics: double diffusion 
    19    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    21    USE timing          ! preformance summary 
    22    USE wrk_nemo        ! working array 
    2313   USE crs 
    2414   USE crsdom 
    2515   USE crslbclnk 
    26    USE iom 
     16   USE oce             ! ocean dynamics and tracers  
     17   USE dom_oce         ! ocean space and time domain 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
     19   USE zdf_oce         ! vertical  physics: ocean fields 
     20   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients 
     21   USE zdfddm          ! vertical  physics: double diffusion 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
     24   USE iom             !  
     25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     26   USE timing          ! preformance summary 
     27   USE wrk_nemo        ! working array 
    2728 
    2829   IMPLICIT NONE 
     
    3031 
    3132   PUBLIC   crs_fld                 ! routines called by step.F90 
    32  
    3333 
    3434   !! * Substitutions 
     
    3737#  include "vectopt_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4040   !! $Id$ 
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    5656      !! ** Method  :   
    5757      !!---------------------------------------------------------------------- 
    58       !! 
    59        
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    61       !! 
    62       INTEGER               ::   ji, jj, jk              ! dummy loop indices 
    63       !! 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    65       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs  
    66       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    67       REAL(wp)       :: z2dcrsu, z2dcrsv 
    68       !! 
    69        !!---------------------------------------------------------------------- 
     58      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     59      ! 
     60      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
     61      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
     62      ! 
     63      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfse3t, zfse3u, zfse3v, zfse3w   ! 3D workspace for e3 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs   
     66      !!---------------------------------------------------------------------- 
    7067      !  
    71  
    7268      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
    7369 
    7470      !  Initialize arrays 
    75       CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    76       CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    77       CALL wrk_alloc( jpi, jpj, jpk, zt, zs       ) 
     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     ) 
    7874      ! 
    7975      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5215 r5758  
    77   !!---------------------------------------------------------------------- 
    88 
    9    USE timing                   ! Timing 
     9   !!---------------------------------------------------------------------- 
     10   !!  crs_init    :  
     11   !!---------------------------------------------------------------------- 
     12   USE par_kind, ONLY: wp 
    1013   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh 
    1114   USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl) 
    12    USE crs                  ! Coarse grid domain 
     15   USE crs                      ! Coarse grid domain 
    1316   USE phycst, ONLY: omega, rad ! physical constants 
    14    USE wrk_nemo  
    15    USE in_out_manager 
    16    USE par_kind, ONLY: wp 
    17    USE iom 
    1817   USE crsdom 
    1918   USE crsdomwri 
    2019   USE crslbclnk 
     20   ! 
     21   USE iom 
     22   USE in_out_manager 
    2123   USE lib_mpp 
     24   USE wrk_nemo  
     25   USE timing                   ! Timing 
    2226 
    2327   IMPLICIT NONE 
    2428   PRIVATE 
    2529 
    26    PUBLIC  crs_init 
     30   PUBLIC   crs_init   ! called by nemogcm.F90 module 
    2731 
    2832   !! * Substitutions 
    2933#  include "domzgr_substitute.h90" 
    30  
     34   !!---------------------------------------------------------------------- 
    3135   !! $Id$ 
     36   !!---------------------------------------------------------------------- 
    3237CONTAINS 
    3338    
     
    6570      !!               - Read in pertinent data ? 
    6671      !!------------------------------------------------------------------- 
    67       !! Local variables 
    6872      INTEGER  :: ji,jj,jk      ! dummy indices 
    6973      INTEGER  :: ierr                                ! allocation error status 
     
    183187      
    184188     ! 
    185      CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 
     189     CALL wrk_alloc( jpi,jpj,jpk,  zfse3t, zfse3u, zfse3v, zfse3w ) 
    186190     ! 
    187191     zfse3t(:,:,:) = fse3t(:,:,:) 
     
    200204     !    3.d.3   Vertical scale factors 
    201205     ! 
    202     
    203    
    204206     CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
    205207     CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
     
    207209     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
    208210 
    209      ! Reset 0 to e3t_0 or e3w_0 
     211     ! Replace 0 by e3t_0 or e3w_0 
    210212     DO jk = 1, jpk 
    211213        DO ji = 1, jpi_crs 
     
    247249     ENDIF 
    248250      
    249      !--------------------------------------------------------- 
    250      ! 7. Finish and clean-up 
    251      !--------------------------------------------------------- 
    252      CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 
    253  
    254  
     251      !--------------------------------------------------------- 
     252      ! 7. Finish and clean-up 
     253      !--------------------------------------------------------- 
     254      CALL wrk_dealloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
     255      ! 
    255256   END SUBROUTINE crs_init 
    256257     
    257258   !!====================================================================== 
    258  
    259259END MODULE crsini 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5737 r5758  
    1717   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1818   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri 
     19   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
     20   !!                 !                     change name of output variables in dia_wri_state 
    1921   !!---------------------------------------------------------------------- 
    2022 
     
    2729   USE dynadv, ONLY: ln_dynadv_vec 
    2830   USE zdf_oce         ! ocean vertical physics 
    29    USE ldftra_oce      ! ocean active tracers: lateral physics 
     31   USE ldftra          ! ocean active tracers: lateral physics 
    3032   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    31    USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv 
    3233   USE sol_oce         ! solver variables 
    3334   USE sbc_oce         ! Surface boundary condition: ocean fields 
     
    248249            DO ji = fs_2, fs_jpim1   ! vector opt. 
    249250               zztmp  = tsn(ji,jj,1,jp_tem) 
    250                zztmpx = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj  ) 
    251                zztmpy = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji  ,jj-1) 
     251               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj) 
     252               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1) 
    252253               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    253254                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
     
    412413      INTEGER  ::   jn, ierror                               ! local integers 
    413414      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars 
    414       !! 
     415      ! 
    415416      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace 
    416417      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace 
     
    419420      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    420421      ! 
    421       CALL wrk_alloc( jpi , jpj      , zw2d ) 
    422       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     422                     CALL wrk_alloc( jpi,jpj      , zw2d ) 
     423      IF( lk_vvl )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d ) 
    423424      ! 
    424425      ! Output the initial state and forcings 
     
    682683         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
    683684            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    684          IF( ln_traldf_gdia ) THEN 
    685             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    686                  &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    687          ELSE 
    688 #if defined key_diaeiv 
    689             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    690             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    691 #endif 
    692          END IF 
    693685         !                                                                                      !!! nid_U : 2D 
    694686         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
     
    700692         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
    701693            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    702          IF( ln_traldf_gdia ) THEN 
    703             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    704                  &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    705          ELSE  
    706 #if defined key_diaeiv 
    707             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    708             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    709 #endif 
    710          END IF 
    711694         !                                                                                      !!! nid_V : 2D 
    712695         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
     
    718701         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
    719702            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    720          IF( ln_traldf_gdia ) THEN 
    721             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    722                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    723          ELSE 
    724 #if defined key_diaeiv 
    725             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    726                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    727 #endif 
    728          END IF 
    729703         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    730704            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
     
    737711         ENDIF 
    738712         !                                                                                      !!! nid_W : 2D 
    739 #if defined key_traldf_c2d 
    740          CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw 
    741             &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    742 # if defined key_traldf_eiv  
    743             CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw 
    744                &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    745 # endif 
    746 #endif 
    747  
    748713         CALL histend( nid_W, snc4chunks=snc4set ) 
    749714 
     
    853818 
    854819      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    855       IF( ln_traldf_gdia ) THEN 
    856          IF (.not. ALLOCATED(psix_eiv))THEN 
    857             ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    858             IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    859             IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv') 
    860             psix_eiv(:,:,:) = 0.0_wp 
    861             psiy_eiv(:,:,:) = 0.0_wp 
    862          ENDIF 
    863          DO jk=1,jpkm1 
    864             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    865          END DO 
    866          zw3d(:,:,jpk) = 0._wp 
    867          CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current 
    868       ELSE 
    869 #if defined key_diaeiv 
    870          CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current 
    871 #endif 
    872       ENDIF 
    873820      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    874821 
    875822      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
    876       IF( ln_traldf_gdia ) THEN 
    877          DO jk=1,jpk-1 
    878             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    879          END DO 
    880          zw3d(:,:,jpk) = 0._wp 
    881          CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current 
    882       ELSE 
    883 #if defined key_diaeiv 
    884          CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current 
    885 #endif 
    886       ENDIF 
    887823      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    888824 
    889825      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    890       IF( ln_traldf_gdia ) THEN 
    891          DO jk=1,jpk-1 
    892             DO jj = 2, jpjm1 
    893                DO ji = fs_2, fs_jpim1  ! vector opt. 
    894                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))*r1_e2v(ji,jj) + & 
    895                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))*r1_e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    896                END DO 
    897             END DO 
    898          END DO 
    899          zw3d(:,:,jpk) = 0._wp 
    900          CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current 
    901       ELSE 
    902 #   if defined key_diaeiv 
    903          CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current 
    904 #   endif 
    905       ENDIF 
    906826      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    907827      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
     
    909829         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef. 
    910830      ENDIF 
    911 #if defined key_traldf_c2d 
    912       CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef. 
    913 # if defined key_traldf_eiv 
    914          CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point 
    915 # endif 
    916 #endif 
    917831 
    918832      ! 3. Close all files 
     
    925839      ENDIF 
    926840      ! 
    927       CALL wrk_dealloc( jpi , jpj      , zw2d ) 
    928       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     841                     CALL wrk_dealloc( jpi , jpj        , zw2d ) 
     842      IF( lk_vvl )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
    929843      ! 
    930844      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
     
    1018932         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth 
    1019933            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1020       END IF 
     934      ENDIF 
    1021935 
    1022936#if defined key_lim2 
     
    1042956      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    1043957      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    1044       CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget 
     958      CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget 
    1045959      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1046960      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
     
    1063977!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
    1064978      !  
    1065  
    1066979   END SUBROUTINE dia_wri_state 
    1067980   !!====================================================================== 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5755 r5758  
    1414   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist 
    1515   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration  
    16    !!            3.7  ! 2015-09  (G. Madec) add cell surface and their inverse 
     16   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse 
    1717   !!                                       add optional read of e1e2u & e1e2v 
    1818   !!---------------------------------------------------------------------- 
     
    126126      ENDIF 
    127127      ! 
    128       ie1e2u_v = 0               !  set to unread e1e2u and e1e2v 
    129128      ! 
    130129      SELECT CASE( jphgr_msh )   !  type of horizontal mesh   
     
    135134         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file' 
    136135         ! 
    137          CALL hgr_read( ie1e2u_v ) 
     136         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v 
     137         ! 
     138         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file 
    138139         ! 
    139140         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them 
     
    141142            e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
    142143            e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    143  
    144          ! 
    145          !                                                ! ===================== 
    146             IF( ie1e2u_v == 0 )   CALL dom_wri_coordinate 
    147             ! 
    148             ! 
    149144         ENDIF 
    150  
    151  
    152          ! 
    153          ! N.B. :  General case, lat and long function of both i and j indices: 
    154          !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   & 
    155          !                                  + (                           fsdiph( zti, ztj ) )**2  ) 
    156          !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   & 
    157          !                                  + (                           fsdiph( zui, zuj ) )**2  ) 
    158          !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   & 
    159          !                                  + (                           fsdiph( zvi, zvj ) )**2  ) 
    160          !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   & 
    161          !                                  + (                           fsdiph( zfi, zfj ) )**2  ) 
    162          ! 
    163          !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   & 
    164          !                                  + (                           fsdjph( zti, ztj ) )**2  ) 
    165          !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   & 
    166          !                                  + (                           fsdjph( zui, zuj ) )**2  ) 
    167          !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   & 
    168          !                                  + (                           fsdjph( zvi, zvj ) )**2  ) 
    169          !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   & 
    170          !                                  + (                           fsdjph( zfi, zfj ) )**2  ) 
    171          ! 
    172145         ! 
    173146      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==! 
     
    214187         ! Position coordinates (in kilometers) 
    215188         !                          ========== 
    216          glam0 = 0.e0 
     189         glam0 = 0._wp 
    217190         gphi0 = - ppe2_m * 1.e-3 
    218191         ! 
     
    309282         ze1 = 106000. / REAL( jp_cfg , wp )             
    310283         ! benchmark: forced the resolution to be about 100 km 
    311          IF( nbench /= 0 )   ze1 = 106000.e0      
     284         IF( nbench /= 0 )   ze1 = 106000._wp      
    312285         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 
    313286         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
     
    444417         ! 
    445418         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    446          zphi0 = 15.e0                                                      ! latitude of the first row F-points 
     419         zphi0 = 15._wp                                                     ! latitude of the first row F-points 
    447420         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    448421         ! 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5332 r5758  
    2929   USE daymod          ! calendar 
    3030   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    31    USE ldftra_oce      ! ocean active tracers: lateral physics 
     31   USE ldftra          ! ocean active tracers: lateral physics 
    3232   USE zdf_oce         ! ocean vertical physics 
    3333   USE phycst          ! physical constants 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r4990 r5758  
    1515   USE phycst         ! physical constants 
    1616   USE ldfdyn_oce     ! ocean dynamics lateral physics 
    17    USE ldftra_oce     ! ocean tracers  lateral physics 
     17   USE ldftra         ! ocean tracers  lateral physics 
    1818   USE ldfslp         ! lateral mixing: slopes of mixing orientation 
    1919   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine) 
     
    7373      CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
    7474      CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian 
    75       CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian 
     75!!gm     CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian 
    7676      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian 
    7777         CALL dyn_ldf_lap    ( kt ) 
     
    7979      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord) 
    8080         CALL dyn_ldf_iso    ( kt ) 
    81          CALL dyn_ldf_bilapg ( kt ) 
     81!!gm         CALL dyn_ldf_bilapg ( kt ) 
    8282      ! 
    8383      CASE ( -1 )                                       ! esopa: test all possibility with control print 
     
    9191                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   & 
    9292            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    93                         CALL dyn_ldf_bilapg ( kt ) 
     93!!gm                        CALL dyn_ldf_bilapg ( kt ) 
    9494                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   & 
    9595            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     
    215215      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' ) 
    216216      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' ) 
    217       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    218          IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' ) 
    219       ENDIF 
     217      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! the rotation needs slope computation 
    220218 
    221219      IF(lwp) THEN 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r4990 r5758  
    11MODULE dynldf_bilapg 
    2    !!====================================================================== 
    3    !!                       ***  MODULE  dynldf_bilapg  *** 
    4    !! Ocean dynamics:  lateral viscosity trend 
    5    !!====================================================================== 
    6    !! History :  OPA  !  1997-07  (G. Madec)  Original code 
    7    !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module 
    8    !!            2.0  !  2004-08  (C. Talandier) New trends organization 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_ldfslp   ||   defined key_esopa 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_ldfslp'                              Rotation of mixing tensor 
    13    !!---------------------------------------------------------------------- 
    14    !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part 
    15    !!                    of the horizontal s-coord. bilaplacian diffusion 
    16    !!   ldfguv         :  
    17    !!---------------------------------------------------------------------- 
    18    USE oce             ! ocean dynamics and tracers 
    19    USE dom_oce         ! ocean space and time domain 
    20    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    21    USE zdf_oce         ! ocean vertical physics 
    22    USE ldfslp          ! iso-neutral slopes available 
    23    USE ldftra_oce, ONLY: ln_traldf_iso 
    24    ! 
    25    USE in_out_manager  ! I/O manager 
    26    USE lib_mpp         ! MPP library 
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28    USE prtctl          ! Print control 
    29    USE wrk_nemo        ! Memory Allocation 
    30    USE timing          ! Timing 
     2   !!============================================================================== 
     3    
     4    
     5   !!    ====>>>   Empty TO BE REMOVED 
     6    
    317 
    32    IMPLICIT NONE 
    33    PRIVATE 
     8   !!============================================================================== 
    349 
    35    PUBLIC   dyn_ldf_bilapg       ! called by step.F90 
    36  
    37    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv) 
    38    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv) 
    39  
    40    !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    42 #  include "ldfdyn_substitute.h90" 
    43    !!---------------------------------------------------------------------- 
    44    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    45    !! $Id$  
    46    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    47    !!---------------------------------------------------------------------- 
    48 CONTAINS 
    49  
    50    INTEGER FUNCTION dyn_ldf_bilapg_alloc() 
    51       !!---------------------------------------------------------------------- 
    52       !!               ***  ROUTINE dyn_ldf_bilapg_alloc  *** 
    53       !!---------------------------------------------------------------------- 
    54       ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     & 
    55          &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc ) 
    56          ! 
    57       IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
    58    END FUNCTION dyn_ldf_bilapg_alloc 
    59  
    60  
    61    SUBROUTINE dyn_ldf_bilapg( kt ) 
    62       !!---------------------------------------------------------------------- 
    63       !!                   ***  ROUTINE dyn_ldf_bilapg  *** 
    64       !!                       
    65       !! ** Purpose :   Compute the before trend of the horizontal momentum 
    66       !!      diffusion and add it to the general trend of momentum equation. 
    67       !! 
    68       !! ** Method  :   The lateral momentum diffusive trends is provided by a  
    69       !!      a 4th order operator rotated along geopotential surfaces. It is  
    70       !!      computed using before fields (forward in time) and geopotential 
    71       !!      slopes computed in routine inildf. 
    72       !!         -1- compute the geopotential harmonic operator applied to 
    73       !!      (ub,vb) and multiply it by the eddy diffusivity coefficient 
    74       !!      (done by a call to ldfgpu and ldfgpv routines) The result is in 
    75       !!      (zwk1,zwk2) arrays. Applied the domain lateral boundary conditions 
    76       !!      by call to lbc_lnk. 
    77       !!         -2- applied to (zwk1,zwk2) the geopotential harmonic operator 
    78       !!      by a second call to ldfgpu and ldfgpv routines respectively. The 
    79       !!      result is in (zwk3,zwk4) arrays. 
    80       !!         -3- Add this trend to the general trend (ta,sa): 
    81       !!            (ua,va) = (ua,va) + (zwk3,zwk4) 
    82       !! 
    83       !! ** Action  : - Update (ua,va) arrays with the before geopotential 
    84       !!                biharmonic mixing trend. 
    85       !!---------------------------------------------------------------------- 
    86       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    87       ! 
    88       INTEGER ::   ji, jj, jk                 ! dummy loop indices 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk1, zwk2, zwk3, zwk4 
    90       !!---------------------------------------------------------------------- 
    91       ! 
    92       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilapg') 
    93       ! 
    94       CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )  
    95       ! 
    96       IF( kt == nit000 ) THEN 
    97          IF(lwp) WRITE(numout,*) 
    98          IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate' 
    99          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    100          !                                      ! allocate dyn_ldf_bilapg arrays 
    101          IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays') 
    102       ENDIF 
    103  
    104       ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum 
    105       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    106          ! 
    107          DO jk = 1, jpk         ! set the slopes of iso-level 
    108             DO jj = 2, jpjm1 
    109                DO ji = 2, jpim1 
    110                   uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    111                   vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    112                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    113                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
    114                END DO 
    115             END DO 
    116          END DO 
    117          ! Lateral boundary conditions on the slopes 
    118          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    119          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    120   
    121 !!bug 
    122          IF( kt == nit000 ) then 
    123             IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
    124                &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj)) 
    125          endif 
    126 !!end 
    127       ENDIF 
    128  
    129       zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0 
    130       zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0 
    131  
    132       ! Laplacian of (ub,vb) multiplied by ahm 
    133       ! --------------------------------------   
    134       CALL ldfguv( ub, vb, zwk1, zwk2, 1 )      ! rotated harmonic operator applied to (ub,vb) 
    135       !                                         ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) ) 
    136       CALL lbc_lnk( zwk1, 'U', -1. )   ;   CALL lbc_lnk( zwk2, 'V', -1. )     ! Lateral boundary conditions 
    137  
    138       ! Bilaplacian of (ub,vb) 
    139       ! ----------------------  
    140       CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 )  ! rotated harmonic operator applied to (zwk1,zwk2)  
    141       !                                         ! (output in (zwk3,zwk4) ) 
    142  
    143       ! Update the momentum trends 
    144       ! -------------------------- 
    145       DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends 
    146          DO jk = 1, jpkm1 
    147             DO ji = 2, jpim1 
    148                ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk) 
    149                va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk) 
    150             END DO 
    151          END DO 
    152       END DO 
    153       ! 
    154       CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )  
    155       ! 
    156       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilapg') 
    157       ! 
    158    END SUBROUTINE dyn_ldf_bilapg 
    159  
    160  
    161    SUBROUTINE ldfguv( pu, pv, plu, plv, kahm ) 
    162       !!---------------------------------------------------------------------- 
    163       !!                  ***  ROUTINE ldfguv  *** 
    164       !!       
    165       !! ** Purpose :   Apply a geopotential harmonic operator to (pu,pv) 
    166       !!      (defined at u- and v-points) and multiply it by the eddy 
    167       !!      viscosity coefficient (if kahm=1). 
    168       !! 
    169       !! ** Method  :   The harmonic operator rotated along geopotential  
    170       !!      surfaces is applied to (pu,pv) using the slopes of geopotential 
    171       !!      surfaces computed in inildf routine. The result is provided in 
    172       !!      (plu,plv) arrays. It is computed in 2 stepv: 
    173       !! 
    174       !!      First step: horizontal part of the operator. It is computed on 
    175       !!      ==========  pu as follows (idem on pv) 
    176       !!      horizontal fluxes : 
    177       !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ] 
    178       !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ] 
    179       !!      take the horizontal divergence of the fluxes (no divided by 
    180       !!      the volume element : 
    181       !!         plu  = di-1[ zftu ] +  dj-1[ zftv ] 
    182       !! 
    183       !!      Second step: vertical part of the operator. It is computed on 
    184       !!      ===========  pu as follows (idem on pv) 
    185       !!      vertical fluxes : 
    186       !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ] 
    187       !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ] 
    188       !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ] 
    189       !!      take the vertical divergence of the fluxes add it to the hori- 
    190       !!      zontal component, divide the result by the volume element and 
    191       !!      if kahm=1, multiply by the eddy diffusivity coefficient: 
    192       !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
    193       !!      else: 
    194       !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
    195       !! 
    196       !! ** Action : 
    197       !!        plu, plv        : partial harmonic operator applied to 
    198       !!                          pu and pv (all the components except 
    199       !!                          second order vertical derivative term) 
    200       !!---------------------------------------------------------------------- 
    201       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
    202       !                                                               ! 2nd call: ahm x these fields 
    203       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to 
    204       !                                                               ! pu and pv (all the components except 
    205       !                                                               ! second order vertical derivative term) 
    206       INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call 
    207       ! 
    208       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    209       REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar 
    210       REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      - 
    211       REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      - 
    212       REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
    213       ! 
    214       REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 
    215       !!---------------------------------------------------------------------- 
    216       ! 
    217       IF( nn_timing == 1 )  CALL timing_start('ldfguv') 
    218       ! 
    219       CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
    220       ! 
    221       !                               ! ********** !   ! =============== 
    222       DO jk = 1, jpkm1                ! First step !   ! Horizontal slab 
    223          !                            ! ********** !   ! =============== 
    224  
    225          ! I.1 Vertical gradient of pu and pv at level jk and jk+1 
    226          ! ------------------------------------------------------- 
    227          ! surface boundary condition: zdku(jk=1)=zdku(jk=2) 
    228          !                             zdkv(jk=1)=zdkv(jk=2) 
    229  
    230          zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1) 
    231          zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1) 
    232  
    233          IF( jk == 1 ) THEN 
    234             zdku(:,:) = zdk1u(:,:) 
    235             zdkv(:,:) = zdk1v(:,:) 
    236          ELSE 
    237             zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk) 
    238             zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk) 
    239          ENDIF 
    240  
    241          !                                -----f----- 
    242          ! I.2 Horizontal fluxes on U          | 
    243          ! ------------------------===     t   u   t 
    244          !                                     | 
    245          ! i-flux at t-point              -----f----- 
    246          DO jj = 1, jpjm1 
    247             DO ji = 2, jpi 
    248                zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 
    249  
    250                zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   & 
    251                               + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    252  
    253                zcof1 = -e2t(ji,jj) * zmkt   & 
    254                      * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    255  
    256                ziut(ji,jj) = tmask(ji,jj,jk) *   & 
    257                            (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   & 
    258                             + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
    259                                        +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) 
    260             END DO 
    261          END DO 
    262  
    263          ! j-flux at f-point 
    264          DO jj = 1, jpjm1 
    265             DO ji = 1, jpim1 
    266                zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 
    267  
    268                zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   & 
    269                               + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. ) 
    270  
    271                zcof2 = -e1f(ji,jj) * zmkf   & 
    272                      * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
    273  
    274                zjuf(ji,jj) = fmask(ji,jj,jk) *   & 
    275                            (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   & 
    276                             + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     & 
    277                                        +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) 
    278             END DO 
    279          END DO 
    280  
    281          !                                 |   t   | 
    282          ! I.3 Horizontal fluxes on V      |       | 
    283          ! ------------------------===     f---v---f 
    284          !                                 |       | 
    285          ! i-flux at f-point               |   t   | 
    286          DO jj = 1, jpjm1 
    287             DO ji = 1, jpim1 
    288                zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 
    289  
    290                zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   & 
    291                               + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    292  
    293                zcof1 = -e2f(ji,jj) * zmkf   & 
    294                      * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
    295  
    296                zivf(ji,jj) = fmask(ji,jj,jk) *   & 
    297                            (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   & 
    298                             + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     & 
    299                                        +zdk1u(ji,jj) + zdku (ji+1,jj) )  ) 
    300             END DO 
    301          END DO 
    302  
    303          ! j-flux at t-point 
    304          DO jj = 2, jpj 
    305             DO ji = 1, jpim1 
    306                zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 
    307  
    308                zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    309                               + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    310  
    311                zcof2 = -e1t(ji,jj) * zmkt   & 
    312                      * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    313  
    314                zjvt(ji,jj) = tmask(ji,jj,jk) *   & 
    315                            (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   & 
    316                             + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     & 
    317                                        +zdk1u(ji,jj-1) + zdku (ji,jj) )  ) 
    318             END DO 
    319          END DO 
    320  
    321  
    322          ! I.4 Second derivative (divergence) (not divided by the volume) 
    323          ! --------------------- 
    324  
    325          DO jj = 2, jpjm1 
    326             DO ji = 2, jpim1 
    327                plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   & 
    328                              + zjuf (ji  ,jj) - zjuf (ji,jj-1) 
    329                plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   & 
    330                              + zjvt (ji,jj+1) - zjvt (ji,jj  )  
    331             END DO 
    332          END DO 
    333  
    334          !                                             ! =============== 
    335       END DO                                           !   End of slab 
    336       !                                                ! =============== 
    337  
    338       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    339  
    340       !                             ! ************ !   ! =============== 
    341       DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab 
    342          !                          ! ************ !   ! =============== 
    343  
    344          ! II.1 horizontal (pu,pv) gradients 
    345          ! --------------------------------- 
    346  
    347          DO jk = 1, jpk 
    348             DO ji = 2, jpi 
    349                ! i-gradient of u at jj 
    350                zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) ) 
    351                ! j-gradient of u and v at jj 
    352                zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) ) 
    353                zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) ) 
    354                ! j-gradient of u and v at jj+1 
    355                zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) ) 
    356                zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji  ,jj  ,jk) ) 
    357             END DO 
    358          END DO 
    359          DO jk = 1, jpk 
    360             DO ji = 1, jpim1 
    361                ! i-gradient of v at jj 
    362                zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) ) 
    363             END DO 
    364          END DO 
    365  
    366  
    367          ! II.2 Vertical fluxes 
    368          ! -------------------- 
    369  
    370          ! Surface and bottom vertical fluxes set to zero 
    371  
    372          zfuw(:, 1 ) = 0.e0 
    373          zfvw(:, 1 ) = 0.e0 
    374          zfuw(:,jpk) = 0.e0 
    375          zfvw(:,jpk) = 0.e0 
    376  
    377          ! interior (2=<jk=<jpk-1) on pu field 
    378  
    379          DO jk = 2, jpkm1 
    380             DO ji = 2, jpim1 
    381                ! i- and j-slopes at uw-point 
    382                zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
    383                zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    384                ! coef. for the vertical dirative 
    385                zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   & 
    386                       * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 
    387                ! weights for the i-k, j-k averaging at t- and f-points, resp. 
    388                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    389                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
    390                zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   & 
    391                              + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. ) 
    392                ! coef. for the horitontal derivative 
    393                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi 
    394                zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj 
    395                ! vertical flux on u field 
    396                zfuw(ji,jk) = umask(ji,jj,jk) *   & 
    397                            (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   & 
    398                             + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     & 
    399                                         +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
    400                             + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     & 
    401                                         +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) ) 
    402             END DO 
    403          END DO 
    404  
    405          ! interior (2=<jk=<jpk-1) on pv field 
    406  
    407          DO jk = 2, jpkm1 
    408             DO ji = 2, jpim1 
    409                ! i- and j-slopes at vw-point 
    410                zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
    411                zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
    412                ! coef. for the vertical derivative 
    413                zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   & 
    414                       * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 
    415                ! weights for the i-k, j-k averaging at f- and t-points, resp. 
    416                zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   & 
    417                              + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. ) 
    418                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   & 
    419                              + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. ) 
    420                ! coef. for the horizontal derivatives 
    421                zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi 
    422                zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj 
    423                ! vertical flux on pv field 
    424                zfvw(ji,jk) = vmask(ji,jj,jk) *   & 
    425                            (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   & 
    426                             + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    427                                         +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    428                             + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    429                                         +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  ) 
    430             END DO 
    431          END DO 
    432  
    433  
    434          ! II.3 Divergence of vertical fluxes added to the horizontal divergence 
    435          ! --------------------------------------------------------------------- 
    436          IF( (kahm -nkahm_smag) ==1 ) THEN 
    437             ! multiply the laplacian by the eddy viscosity coefficient 
    438             DO jk = 1, jpkm1 
    439                DO ji = 2, jpim1 
    440                   ! eddy coef. divided by the volume element 
    441                   zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
    442                   zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
    443                   ! vertical divergence 
    444                   zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 
    445                   zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
    446                   ! harmonic operator applied to (pu,pv) and multiply by ahm 
    447                   plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 
    448                   plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 
    449                END DO 
    450             END DO 
    451          ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN 
    452             ! second call, no multiplication 
    453             DO jk = 1, jpkm1 
    454                DO ji = 2, jpim1 
    455                   ! inverse of the volume element 
    456                   zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
    457                   zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
    458                   ! vertical divergence 
    459                   zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 
    460                   zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
    461                   ! harmonic operator applied to (pu,pv)  
    462                   plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 
    463                   plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 
    464                END DO 
    465             END DO 
    466          ELSE 
    467             IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
    468             IF(lwp)WRITE(numout,*) '         We stop' 
    469             STOP 'ldfguv' 
    470          ENDIF 
    471          !                                             ! =============== 
    472       END DO                                           !   End of slab 
    473       !                                                ! =============== 
    474  
    475       CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
    476       ! 
    477       IF( nn_timing == 1 )  CALL timing_stop('ldfguv') 
    478       ! 
    479    END SUBROUTINE ldfguv 
    480  
    481 #else 
    482    !!---------------------------------------------------------------------- 
    483    !!   Dummy module :                         NO rotation of mixing tensor 
    484    !!---------------------------------------------------------------------- 
    485 CONTAINS 
    486    SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine 
    487       INTEGER, INTENT(in) :: kt 
    488       WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 
    489    END SUBROUTINE dyn_ldf_bilapg 
    490 #endif 
    491  
    492    !!====================================================================== 
    49310END MODULE dynldf_bilapg 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r4990 r5758  
    99   !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_ldfslp   ||   defined key_esopa 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_ldfslp'                      slopes of the direction of mixing 
     11 
    1412   !!---------------------------------------------------------------------- 
    1513   !!   dyn_ldf_iso  : update the momentum trend with the horizontal part 
     
    2018   USE dom_oce         ! ocean space and time domain 
    2119   USE ldfdyn_oce      ! ocean dynamics lateral physics 
    22    USE ldftra_oce      ! ocean tracer   lateral physics 
     20   USE ldftra          ! lateral physics: eddy diffusivity & EIV coefficients 
    2321   USE zdf_oce         ! ocean vertical physics 
    2422   USE ldfslp          ! iso-neutral slopes  
     
    106104      !!      of the rotated operator in dynzdf module 
    107105      !!---------------------------------------------------------------------- 
    108       ! 
    109106      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    110107      ! 
     
    189186                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    190187 
    191                   zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     188                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    192189    
    193190                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   & 
     
    204201                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    205202 
    206                   zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     203                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    207204 
    208205                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   & 
     
    221218                  &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. ) 
    222219 
    223                zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
     220               zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
    224221 
    225222               zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   & 
     
    242239                  &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    243240 
    244                zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
     241               zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
    245242 
    246243               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )   & 
     
    259256                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    260257 
    261                   zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     258                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    262259 
    263260                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   & 
     
    274271                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    275272 
    276                   zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     273                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    277274 
    278275                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   & 
     
    358355         DO jk = 2, jpkm1 
    359356            DO ji = 2, jpim1 
    360                zcoef0= 0.5 * aht0 * umask(ji,jj,jk) 
    361  
     357               zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 
     358               ! 
    362359               zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
    363360               zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    364  
     361               ! 
    365362               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    366363                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
     
    376373                                       +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
    377374               ! update avmu (add isopycnal vertical coefficient to avmu) 
    378                ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0 
    379                avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0 
     375               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     376               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 
    380377            END DO 
    381378         END DO 
     
    384381         DO jk = 2, jpkm1 
    385382            DO ji = 2, jpim1 
    386                zcoef0= 0.5 * aht0 * vmask(ji,jj,jk) 
     383               zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 
    387384 
    388385               zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
     
    398395               ! vertical flux on v field 
    399396               zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    400                                        +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    401                            + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    402                                        +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
     397                  &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
     398                  &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
     399                  &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
    403400               ! update avmv (add isopycnal vertical coefficient to avmv) 
    404                ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0 
    405                avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0 
     401               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     402               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 
    406403            END DO 
    407404         END DO 
     
    413410            DO ji = 2, jpim1 
    414411               ! volume elements 
    415                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    416                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     412               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     413               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
    417414               ! part of the k-component of isopycnal momentum diffusive trends 
    418415               zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu 
     
    432429   END SUBROUTINE dyn_ldf_iso 
    433430 
    434 # else 
    435    !!---------------------------------------------------------------------- 
    436    !!   Dummy module                           NO rotation of mixing tensor 
    437    !!---------------------------------------------------------------------- 
    438 CONTAINS 
    439    SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine 
    440       INTEGER, INTENT(in) :: kt 
    441       WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt 
    442    END SUBROUTINE dyn_ldf_iso 
    443 #endif 
    444  
    445431   !!====================================================================== 
    446432END MODULE dynldf_iso 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r5400 r5758  
    139139      !! 
    140140      !!---------------------------------------------------------------------- 
    141       USE ldftra_oce, ONLY:   aht0 
     141      USE ldftra, ONLY:   rn_aht_0 
    142142      USE iom 
    143143      ! 
     
    254254         ! symmetric in the south hemisphere) 
    255255 
    256          zahmeq = aht0 
     256         zahmeq = rn_aht_0 
    257257 
    258258         DO jj = 1, jpj 
     
    336336      !! 
    337337      !!---------------------------------------------------------------------- 
    338       USE ldftra_oce, ONLY:   aht0 
     338      USE ldftra, ONLY:   rn_aht_0 
    339339      USE iom 
    340340      ! 
     
    452452         ! symmetric in the south hemisphere) 
    453453 
    454          zahmeq = aht0 
     454         zahmeq = rn_aht_0 
    455455         zam20s = ahm0*COS( rad * 20. ) 
    456456 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r5400 r5758  
    2626      !!       ??? explanation of the default is missing 
    2727      !!---------------------------------------------------------------------- 
    28       USE ldftra_oce, ONLY :   aht0 
     28      USE ldftra, ONLY :   rn_aht_0 
    2929      USE iom 
    3030      !! 
     
    193193      !! ** Method  :   blah blah blah .... 
    194194      !!---------------------------------------------------------------------- 
    195       USE ldftra_oce, ONLY:   aht0 
     195      USE ldftra, ONLY:   rn_aht_0 
    196196      USE iom 
    197197      !! 
     
    248248       
    249249      IF( jp_cfg == 4 )   THEN 
    250          zahmeq = 5.0 * aht0 
     250         zahmeq = 5.0 * rn_aht_0 
    251251         zahmm  = min( 160000.0, ahm0) 
    252252         zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) 
     
    273273 
    274274      IF( jp_cfg == 2 )   THEN 
    275          zahmeq     = aht0 
     275         zahmeq     = rn_aht_0 
    276276         zahmm      = ahm0 
    277277         zahm0(:,:) = ahm0 
     
    279279 
    280280      IF( jp_cfg == 1 )   THEN 
    281          zahmeq     = aht0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required 
     281         zahmeq     = rn_aht_0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required 
    282282         zahmm      = ahm0 
    283283         zahm0(:,:) = ahm0 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5737 r5758  
    1111   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator 
    1212   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML 
     13   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  add limiter on triad slopes 
    1314   !!---------------------------------------------------------------------- 
    14 #if   defined key_ldfslp   ||   defined key_esopa 
     15 
    1516   !!---------------------------------------------------------------------- 
    16    !!   'key_ldfslp'                      Rotation of lateral mixing tensor 
    17    !!---------------------------------------------------------------------- 
    18    !!   ldf_slp_grif  : calculates the triads of isoneutral slopes (Griffies operator) 
    1917   !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator) 
     18   !!   ldf_slp_triad : calculates the triads of isoneutral slopes (Griffies operator) 
    2019   !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator) 
    2120   !!   ldf_slp_init  : initialization of the slopes computation 
     
    2322   USE oce            ! ocean dynamics and tracers 
    2423   USE dom_oce        ! ocean space and time domain 
    25    USE ldftra_oce     ! lateral diffusion: traceur 
    26    USE ldfdyn_oce     ! lateral diffusion: dynamics 
     24!!gm 
     25!   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
     26!!gm to be removed 
     27   USE ldfdyn_oce         ! lateral diffusion: eddy viscosity coef. 
     28!!gm 
    2729   USE phycst         ! physical constants 
    2830   USE zdfmxl         ! mixed layer depth 
     
    3032   ! 
    3133   USE in_out_manager ! I/O manager 
     34   USE prtctl         ! Print control 
    3235   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    33    USE prtctl         ! Print control 
     36   USE lib_mpp        ! distribued memory computing library 
     37   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3438   USE wrk_nemo       ! work arrays 
    3539   USE timing         ! Timing 
    36    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3740 
    3841   IMPLICIT NONE 
    3942   PRIVATE 
    4043 
    41    PUBLIC   ldf_slp        ! routine called by step.F90 
    42    PUBLIC   ldf_slp_grif   ! routine called by step.F90 
    43    PUBLIC   ldf_slp_init   ! routine called by opa.F90 
    44  
    45    LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag 
    46    !                                                                             !! Madec operator 
    47    !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     44   PUBLIC   ldf_slp         ! routine called by step.F90 
     45   PUBLIC   ldf_slp_triad   ! routine called by step.F90 
     46   PUBLIC   ldf_slp_init    ! routine called by nemogcm.F90 
     47 
     48   LOGICAL , PUBLIC ::   l_ldfslp = .FALSE.     !: slopes flag 
     49 
     50   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction 
     51   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme 
     52 
     53   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML 
     54   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom 
     55   REAL(wp), PUBLIC ::   rn_sw_triad     = 1._wp        !: =1 switching triads ; =0 all four triads used  
     56   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit 
     57 
     58   LOGICAL , PUBLIC ::   l_grad_zps = .FALSE.           !: special treatment for Horz Tgradients w partial steps (triad operator) 
     59    
     60   !                                                     !! Classic operator (Madec) 
    4861   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points 
    4962   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points 
    50    !                                                                !! Griffies operator 
     63   !                                                     !! triad operator (Griffies) 
    5164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells 
    5265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
    5366   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate 
    54  
    55    !                                                              !! Madec operator 
    56    !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     67   !                                                     !! both operators 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ah_wslp2             !: ah * slope^2 at w-point 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   akz                  !: stabilizing vertical diffusivity 
     70    
     71   !                                                     !! Madec operator 
    5772   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt 
    5873   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer 
     
    6378   !! * Substitutions 
    6479#  include "domzgr_substitute.h90" 
    65 #  include "ldftra_substitute.h90" 
    66 #  include "ldfeiv_substitute.h90" 
    6780#  include "vectopt_loop_substitute.h90" 
    6881   !!---------------------------------------------------------------------- 
    69    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     82   !! NEMO/OPA 4.0 , NEMO Consortium (2014) 
    7083   !! $Id$ 
    7184   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    105118      INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    106119      INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
    107       REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 
     120      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 
    108121      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    109122      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    110123      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
    111       REAL(wp) ::   zdepv, zdepu         !   -      - 
    112124      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww 
    113125      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr 
    114126      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv 
    115       REAL(wp), POINTER, DIMENSION(:,:  ) :: zhmlpu, zhmlpv 
    116127      !!---------------------------------------------------------------------- 
    117128      ! 
     
    119130      ! 
    120131      CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    121       CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv ) 
    122  
    123       IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN  
    124       
    125          zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    126          z1_16  =  1.0_wp / 16._wp 
    127          zm1_g  = -1.0_wp / grav 
    128          zm1_2g = -0.5_wp / grav 
    129          ! 
    130          zww(:,:,:) = 0._wp 
    131          zwz(:,:,:) = 0._wp 
    132          ! 
    133          DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    134             DO jj = 1, jpjm1 
    135                DO ji = 1, fs_jpim1   ! vector opt. 
    136                   zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
    137                   zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
    138                END DO 
    139             END DO 
    140          END DO 
    141          IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    142             DO jj = 1, jpjm1 
    143                DO ji = 1, jpim1 
    144                   zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    145                   zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
    146                END DO 
    147             END DO 
    148          ENDIF 
    149          IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
    150             DO jj = 1, jpjm1 
    151                DO ji = 1, jpim1 
    152                IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
    153                IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
    154                END DO 
    155             END DO 
    156          ENDIF 
    157          ! 
    158          !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    159          ! interior value 
    160          DO jk = 2, jpkm1 
    161             !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    162             !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
    163             !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
    164             !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    165             !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    166             zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
    167                &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
    168          END DO 
    169          ! surface initialisation  
    170          zdzr(:,:,1) = 0._wp  
    171          IF ( ln_isfcav ) THEN 
    172             ! if isf need to overwrite the interior value at at the first ocean point 
    173             DO jj = 1, jpjm1 
    174                DO ji = 1, jpim1 
    175                   zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 
    176                END DO 
    177             END DO 
    178          END IF 
    179          ! 
    180          !                          !==   Slopes just below the mixed layer   ==! 
    181          CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
    182  
    183  
    184          ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
    185          ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    186          ! 
    187          IF ( ln_isfcav ) THEN 
    188             DO jj = 2, jpjm1 
    189                DO ji = fs_2, fs_jpim1   ! vector opt. 
    190                   IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
    191                   IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp) 
    192                   IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp) 
    193                   IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
    194                   IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp) 
    195                   IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp) 
    196                ENDDO 
    197             ENDDO 
    198          ELSE 
    199             DO jj = 2, jpjm1 
    200                DO ji = fs_2, fs_jpim1   ! vector opt. 
    201                   zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp) 
    202                   zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp) 
    203                ENDDO 
    204             ENDDO 
    205          END IF 
    206          DO jk = 2, jpkm1                            !* Slopes at u and v points 
    207             DO jj = 2, jpjm1 
    208                DO ji = fs_2, fs_jpim1   ! vector opt. 
    209                   !                                      ! horizontal and vertical density gradient at u- and v-points 
    210                   zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 
    211                   zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 
    212                   zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
    213                   zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
    214                   !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    215                   !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    216                   zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  ) 
    217                   zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
    218                   !                                      ! uslp and vslp output in zwz and zww, resp. 
    219                   zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj  ,jk) ) 
    220                   zfj = MAX( omlmask(ji,jj,jk), omlmask(ji  ,jj+1,jk) ) 
    221                   ! thickness of water column between surface and level k at u/v point 
    222                   zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                              & 
    223                                    - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) ) - fse3u(ji,jj,miku(ji,jj)) ) 
    224                   zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                              & 
    225                                    - 2 * MAX( risfdep(ji,jj), risfdep(ji  ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) ) 
    226                   ! 
    227                   zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                          & 
    228                      &                 + zfi  * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj) 
    229                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk) 
    230                   zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                          & 
    231                      &                 + zfj  * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj)  
    232                   zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk) 
    233                    
    234                   
     132 
     133      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
     134      z1_16  =  1.0_wp / 16._wp 
     135      zm1_g  = -1.0_wp / grav 
     136      zm1_2g = -0.5_wp / grav 
     137      z1_slpmax = 1._wp / rn_slpmax 
     138      ! 
     139      zww(:,:,:) = 0._wp 
     140      zwz(:,:,:) = 0._wp 
     141      ! 
     142      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
     143         DO jj = 1, jpjm1 
     144            DO ji = 1, fs_jpim1   ! vector opt. 
     145               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
     146               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
     147            END DO 
     148         END DO 
     149      END DO 
     150      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
     151         DO jj = 1, jpjm1 
     152            DO ji = 1, jpim1 
     153               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
     154               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     155            END DO 
     156         END DO 
     157      ENDIF 
     158      ! 
     159      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     160      DO jk = 2, jpkm1 
     161         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     162         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
     163         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
     164         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
     165         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
     166         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
     167            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
     168      END DO 
     169      ! 
     170      !                          !==   Slopes just below the mixed layer   ==! 
     171      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
     172 
     173 
     174      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
     175      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
     176      ! 
     177      DO jk = 2, jpkm1                            !* Slopes at u and v points 
     178         DO jj = 2, jpjm1 
     179            DO ji = fs_2, fs_jpim1   ! vector opt. 
     180               !                                      ! horizontal and vertical density gradient at u- and v-points 
     181               zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 
     182               zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 
     183               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
     184               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
     185               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
     186               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     187               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  ) 
     188               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
     189               !                                      ! uslp and vslp output in zwz and zww, resp. 
     190               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
     191               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
     192               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
     193                  &                   + zfi  * uslpml(ji,jj)                                                     & 
     194                  &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   & 
     195                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
     196               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
     197                  &                   + zfj  * vslpml(ji,jj)                                                     & 
     198                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   & 
     199                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
    235200!!gm  modif to suppress omlmask.... (as in Griffies case) 
    236 !                  !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0. 
    237 !                  zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
    238 !                  zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
    239 !                  zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
    240 !                  zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
    241 !                  zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
    242 !                  zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
     201!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0. 
     202!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
     203!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
     204!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
     205!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
     206!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
     207!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
    243208!!gm end modif 
    244                END DO 
    245             END DO 
    246          END DO 
    247          CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
    248          ! 
    249          !                                            !* horizontal Shapiro filter 
    250          DO jk = 2, jpkm1 
    251             DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    252                DO ji = 2, jpim1 
    253                   uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    254                      &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
    255                      &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
    256                      &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
    257                      &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
    258                   vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
    259                      &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
    260                      &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
    261                      &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
    262                      &                       + 4.*  zww(ji,jj    ,jk)                       ) 
    263                END DO 
    264             END DO 
    265             DO jj = 3, jpj-2                               ! other rows 
    266                DO ji = fs_2, fs_jpim1   ! vector opt. 
    267                   uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    268                      &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
    269                      &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
    270                      &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
    271                      &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
    272                   vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
    273                      &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
    274                      &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)         & 
    275                      &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
    276                      &                       + 4.*  zww(ji,jj    ,jk)                       ) 
    277                END DO 
    278             END DO 
    279             !                                        !* decrease along coastal boundaries 
    280             DO jj = 2, jpjm1 
    281                DO ji = fs_2, fs_jpim1   ! vector opt. 
    282                   uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   & 
    283                      &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp   & 
    284                      &                            *   umask(ji,jj,jk-1) 
    285                   vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   & 
    286                      &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp   & 
    287                      &                            *   vmask(ji,jj,jk-1) 
    288                END DO 
    289             END DO 
    290          END DO 
    291  
    292  
    293          ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
    294          ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    295          ! 
    296          DO jk = 2, jpkm1 
    297             DO jj = 2, jpjm1 
    298                DO ji = fs_2, fs_jpim1   ! vector opt. 
    299                   !                                  !* Local vertical density gradient evaluated from N^2 
    300                   zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk) 
    301                   !                                  !* Slopes at w point 
    302                   !                                        ! i- & j-gradient of density at w-points 
    303                   zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           & 
    304                      &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj) 
    305                   zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           & 
    306                      &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj) 
    307                   zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           & 
    308                      &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci 
    309                   zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           & 
    310                      &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj 
    311                   !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    312                   !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    313                   zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  ) 
    314                   zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
    315                   !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    316                   zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    317                   zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 
    318                   zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 
    319                      &            + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    320                   zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 
    321                      &            + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
     209            END DO 
     210         END DO 
     211      END DO 
     212      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
     213      ! 
     214      !                                            !* horizontal Shapiro filter 
     215      DO jk = 2, jpkm1 
     216         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     217            DO ji = 2, jpim1 
     218               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
     219                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     220                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
     221                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
     222                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
     223               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
     224                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
     225                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
     226                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
     227                  &                       + 4.*  zww(ji,jj    ,jk)                       ) 
     228            END DO 
     229         END DO 
     230         DO jj = 3, jpj-2                               ! other rows 
     231            DO ji = fs_2, fs_jpim1   ! vector opt. 
     232               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
     233                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     234                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
     235                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
     236                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
     237               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
     238                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
     239                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
     240                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
     241                  &                       + 4.*  zww(ji,jj    ,jk)                       ) 
     242            END DO 
     243         END DO 
     244         !                                        !* decrease along coastal boundaries 
     245         DO jj = 2, jpjm1 
     246            DO ji = fs_2, fs_jpim1   ! vector opt. 
     247               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   & 
     248                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp 
     249               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   & 
     250                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp 
     251            END DO 
     252         END DO 
     253      END DO 
     254 
     255 
     256      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
     257      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
     258      ! 
     259      DO jk = 2, jpkm1 
     260         DO jj = 2, jpjm1 
     261            DO ji = fs_2, fs_jpim1   ! vector opt. 
     262               !                                  !* Local vertical density gradient evaluated from N^2 
     263               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 
     264               !                                  !* Slopes at w point 
     265               !                                        ! i- & j-gradient of density at w-points 
     266               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           & 
     267                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj) 
     268               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           & 
     269                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj) 
     270               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           & 
     271                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk) 
     272               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           & 
     273                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk) 
     274               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
     275               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     276               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  ) 
     277               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
     278               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
     279               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
     280               zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
     281               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
     282               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
    322283 
    323284!!gm  modif to suppress omlmask....  (as in Griffies operator) 
    324 !                  !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
    325 !                  zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
    326 !                  zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
    327 !                  zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    328 !                  zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
     285!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
     286!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
     287!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
     288!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
     289!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    329290!!gm end modif 
    330                END DO 
    331             END DO 
    332          END DO 
    333          CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    334          ! 
    335          !                                           !* horizontal Shapiro filter 
    336          DO jk = 2, jpkm1 
    337             DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    338                DO ji = 2, jpim1 
    339                   zcofw = tmask(ji,jj,jk) * z1_16 
    340                   wslpi(ji,jj,jk) = (          zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    341                        &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    342                        &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    343                        &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    344                        &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    345  
    346                   wslpj(ji,jj,jk) = (          zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    347                        &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    348                        &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    349                        &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    350                        &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
    351                END DO 
    352             END DO 
    353             DO jj = 3, jpj-2                               ! other rows 
    354                DO ji = fs_2, fs_jpim1   ! vector opt. 
    355                   zcofw = tmask(ji,jj,jk) * z1_16 
    356                   wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    357                        &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    358                        &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    359                        &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    360                        &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    361  
    362                   wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    363                        &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    364                        &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    365                        &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    366                        &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
    367                END DO 
    368             END DO 
    369             !                                        !* decrease along coastal boundaries 
    370             DO jj = 2, jpjm1 
    371                DO ji = fs_2, fs_jpim1   ! vector opt. 
    372                   zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   & 
    373                      &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 
    374                   wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk) 
    375                   wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk) 
    376                END DO 
    377             END DO 
    378          END DO 
    379  
    380          ! III.  Specific grid points 
    381          ! =========================== 
    382          ! 
    383          IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area 
    384             !                                                    ! Gibraltar Strait 
    385             ij0 =  50   ;   ij1 =  53 
    386             ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    387             ij0 =  51   ;   ij1 =  53 
    388             ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    389             ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    390             ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    391             ! 
    392             !                                                    ! Mediterrannean Sea 
    393             ij0 =  49   ;   ij1 =  56 
    394             ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    395             ij0 =  50   ;   ij1 =  56 
    396             ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    397             ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    398             ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    399          ENDIF 
    400  
    401  
    402          ! IV. Lateral boundary conditions 
    403          ! =============================== 
    404          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    405          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    406  
    407  
    408          IF(ln_ctl) THEN 
    409             CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
    410             CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
    411          ENDIF 
    412          ! 
    413  
    414       ELSEIF ( lk_vvl ) THEN  
    415   
    416          IF(lwp) THEN  
    417             WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'  
    418          ENDIF  
    419  
    420          ! geopotential diffusion in s-coordinates on tracers and/or momentum  
    421          ! The slopes of s-surfaces are computed at each time step due to vvl  
    422          ! The slopes for momentum diffusion are i- or j- averaged of those on tracers  
    423  
    424          ! set the slope of diffusion to the slope of s-surfaces  
    425          !      ( c a u t i o n : minus sign as fsdep has positive value )  
    426          DO jj = 2, jpjm1  
    427             DO ji = fs_2, fs_jpim1   ! vector opt.  
    428                uslp (ji,jj,1) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1)  
    429                vslp (ji,jj,1) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1)  
    430                wslpi(ji,jj,1) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5  
    431                wslpj(ji,jj,1) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5  
    432             END DO  
    433          END DO  
    434  
    435          DO jk = 2, jpk  
    436             DO jj = 2, jpjm1  
    437                DO ji = fs_2, fs_jpim1   ! vector opt.  
    438                   uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)  
    439                   vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
    440                   wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 
    441                   wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5  
    442                END DO  
    443             END DO  
    444          END DO  
    445  
    446          ! Lateral boundary conditions on the slopes  
    447          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )  
    448          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )  
    449    
    450          if( kt == nit000 ) then  
    451             IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &  
    452                &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj))  
    453          endif  
    454    
    455          IF(ln_ctl) THEN  
    456             CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)  
    457             CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)  
    458          ENDIF  
    459  
     291            END DO 
     292         END DO 
     293      END DO 
     294      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
     295      ! 
     296      !                                           !* horizontal Shapiro filter 
     297      DO jk = 2, jpkm1 
     298         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     299            DO ji = 2, jpim1 
     300               zcofw = wmask(ji,jj,jk) * z1_16 
     301               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     302                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     303                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     304                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     305                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
     306 
     307               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
     308                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     309                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     310                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     311                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     312            END DO 
     313         END DO 
     314         DO jj = 3, jpj-2                               ! other rows 
     315            DO ji = fs_2, fs_jpim1   ! vector opt. 
     316               zcofw = wmask(ji,jj,jk) * z1_16 
     317               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     318                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     319                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     320                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     321                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
     322 
     323               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
     324                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     325                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     326                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     327                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     328            END DO 
     329         END DO 
     330         !                                        !* decrease in vicinity of topography 
     331         DO jj = 2, jpjm1 
     332            DO ji = fs_2, fs_jpim1   ! vector opt. 
     333               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   & 
     334                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 
     335               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 
     336               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 
     337            END DO 
     338         END DO 
     339      END DO 
     340 
     341      ! IV. Lateral boundary conditions 
     342      ! =============================== 
     343      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
     344      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
     345 
     346 
     347      IF(ln_ctl) THEN 
     348         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
     349         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
    460350      ENDIF 
    461        
     351      ! 
    462352      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    463       CALL wrk_dealloc( jpi,jpj,     zhmlpu, zhmlpv) 
    464353      ! 
    465354      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp') 
     
    468357 
    469358 
    470    SUBROUTINE ldf_slp_grif ( kt ) 
    471       !!---------------------------------------------------------------------- 
    472       !!                 ***  ROUTINE ldf_slp_grif  *** 
     359   SUBROUTINE ldf_slp_triad ( kt ) 
     360      !!---------------------------------------------------------------------- 
     361      !!                 ***  ROUTINE ldf_slp_triad  *** 
    473362      !! 
    474363      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope 
    475       !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T) 
     364      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T) 
    476365      !!      at W-points using the Griffies quarter-cells. 
    477366      !! 
     
    488377      REAL(wp) ::   zfacti, zfactj              ! local scalars 
    489378      REAL(wp) ::   znot_thru_surface           ! local scalars 
    490       REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj 
     379      REAL(wp) ::   zdit, zdis, zdkt, zbu, zbti, zisw 
     380      REAL(wp) ::   zdjt, zdjs, zdks, zbv, zbtj, zjsw 
    491381      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim 
    492382      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    493383      REAL(wp) ::   zdzrho_raw 
     384      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2 
    494385      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
     386      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    495387      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    496388      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    497389      !!---------------------------------------------------------------------- 
    498390      ! 
    499       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif') 
     391      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad') 
    500392      ! 
    501393      CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
     394      CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    502395      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    503396      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
     
    519412                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj) 
    520413                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj) 
    521                   zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    522                   zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
     414                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
     415                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    523416               END DO 
    524417            END DO 
     
    552445                     zdks = 0._wp 
    553446                  ENDIF 
    554                   zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 
    555                   zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw )    ! force zdzrho >= repsln 
     447                  zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
     448                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln 
    556449                 END DO 
    557450            END DO 
     
    586479                  ! 
    587480                  jk = nmln(ji+ip,jj) + 1 
    588                   IF( jk .GT. mbkt(ji+ip,jj) ) THEN  !ML reaches bottom 
    589                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp 
    590                   ELSE 
    591                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    592                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    593                        &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
    594                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
     481                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom 
     482                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp 
     483                  ELSE                              
     484                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
     485                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
     486                        &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
     487                     ze3_e1    =  fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)  
     488                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw ) 
    595489                  ENDIF 
    596490                  ! 
    597491                  jk = nmln(ji,jj+jp) + 1 
    598492                  IF( jk .GT. mbkt(ji,jj+jp) ) THEN  !ML reaches bottom 
    599                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp 
     493                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp 
    600494                  ELSE 
    601                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    602                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    603                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
     495                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
     496                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     497                     ze3_e2    =  fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj) 
     498                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw ) 
    604499                  ENDIF 
    605500               END DO 
     
    628523                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti) 
    629524                     ! 
    630                      zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                             ! unmasked 
     525                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked 
    631526                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp) 
    632  
     527                     ! 
    633528                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    634529                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 
     
    636531                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    637532                     ztj_g_raw = ztj_raw - ztj_coord 
    638                      zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    639                      ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
     533                     ! additional limit required in bilaplacian case 
     534                     ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj) 
     535                     ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj) 
     536                     ! NB: hard coded factor 5 (can be a namelist parameter...) 
     537                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 
     538                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    640539                     ! 
    641540                     ! Below  ML use limited zti_g as is & mask 
     
    666565                     ! 
    667566                     IF( ln_triad_iso ) THEN 
    668                         zti_raw = zti_lim**2 / zti_raw 
    669                         ztj_raw = ztj_lim**2 / ztj_raw 
     567                        zti_raw = zti_lim*zti_lim / zti_raw 
     568                        ztj_raw = ztj_lim*ztj_lim / ztj_raw 
    670569                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 
    671570                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 
    672                         zti_lim =           zfacti   * zti_lim                       & 
    673                         &      + ( 1._wp - zfacti ) * zti_raw 
    674                         ztj_lim =           zfactj   * ztj_lim                       & 
    675                         &      + ( 1._wp - zfactj ) * ztj_raw 
     571                        zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw 
     572                        ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw 
    676573                     ENDIF 
    677                      triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim 
    678                      triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim 
    679                     ! 
    680                      zbu  = e1e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
    681                      zbv  = e1e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
    682                      zbti = e1e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 
    683                      zbtj = e1e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
    684                      ! 
    685                      !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
    686                      wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked 
    687                      wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2 
     574                     !                                      ! switching triad scheme  
     575                     zisw = (rn_sw_triad - 1._wp ) + rn_sw_triad    & 
     576                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  ) 
     577                     zjsw = (rn_sw_triad - 1._wp ) + rn_sw_triad    & 
     578                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  ) 
     579                     ! 
     580                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw 
     581                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 
     582                     ! 
     583                     zbu  = e1e2u(ji   ,jj   ) * fse3u(ji   ,jj   ,jk   ) 
     584                     zbv  = e1e2v(ji   ,jj   ) * fse3v(ji   ,jj   ,jk   ) 
     585                     zbti = e1e2t(ji+ip,jj   ) * fse3w(ji+ip,jj   ,jk+kp) 
     586                     zbtj = e1e2t(ji   ,jj+jp) * fse3w(ji   ,jj+jp,jk+kp) 
     587                     ! 
     588                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked 
     589                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim 
    688590                  END DO 
    689591               END DO 
     
    697599      ! 
    698600      CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
     601      CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    699602      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    700603      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    701604      ! 
    702       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif') 
    703       ! 
    704    END SUBROUTINE ldf_slp_grif 
     605      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad') 
     606      ! 
     607   END SUBROUTINE ldf_slp_triad 
    705608 
    706609 
     
    728631      INTEGER  ::   ji , jj , jk                   ! dummy loop indices 
    729632      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers 
    730       REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars 
     633      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars 
    731634      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    732635      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
     
    739642      zm1_g  = -1.0_wp / grav 
    740643      zm1_2g = -0.5_wp / grav 
     644      z1_slpmax = 1._wp / rn_slpmax 
    741645      ! 
    742646      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
     
    750654            DO ji = 1, jpi 
    751655               ik = nmln(ji,jj) - 1 
    752                IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN 
    753                   omlmask(ji,jj,jk) = 1._wp 
    754                ELSE 
    755                   omlmask(ji,jj,jk) = 0._wp 
     656               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
     657               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp 
    756658               ENDIF 
    757659            END DO 
     
    775677            ! 
    776678            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point) 
    777             iku = MIN(  MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1) 
    778             ikv = MIN(  MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   ! 
     679            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1) 
     680            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   ! 
    779681            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) ) 
    780682            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) ) 
     
    784686            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    785687            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    786             zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
    787             zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
     688            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
     689            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
    788690            !                        !- Slope at u- & v-points (uslpml, vslpml) 
    789691            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 
     
    810712            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  ) 
    811713            !                        !- i- & j-slope at w-points (wslpiml, wslpjml) 
    812             wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik) 
    813             wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik) 
     714            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 
     715            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik) 
    814716         END DO 
    815717      END DO 
     
    829731      !! ** Purpose :   Initialization for the isopycnal slopes computation 
    830732      !! 
    831       !! ** Method  :   read the nammbf namelist and check the parameter 
    832       !!      values called by tra_dmp at the first timestep (nit000) 
     733      !! ** Method  :    
    833734      !!---------------------------------------------------------------------- 
    834735      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     
    843744         WRITE(numout,*) '~~~~~~~~~~~~' 
    844745      ENDIF 
    845  
    846       IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes 
    847          ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    848          ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr ) 
    849          IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
    850          ! 
     746      ! 
     747      ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr ) 
     748      IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' ) 
     749      ! 
     750      IF( ln_traldf_triad ) THEN        ! Griffies operator : triad of slopes 
     751         IF(lwp) WRITE(numout,*) '              Griffies (triad) operator initialisation' 
     752         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) ,     & 
     753            &      triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1) ,     & 
     754            &      wslp2   (jpi,jpj,jpk)                                         , STAT=ierr ) 
     755         IF( ierr > 0      )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
    851756         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 
    852757         ! 
    853758      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    854          ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                & 
    855             &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr ) 
     759         IF(lwp) WRITE(numout,*) '              Madec operator initialisation' 
     760         ALLOCATE( omlmask(jpi,jpj,jpk) ,                                                                        & 
     761            &      uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) ,     & 
     762            &      vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr ) 
    856763         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 
    857764 
     
    863770         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
    864771 
    865          IF(ln_sco .AND.  (ln_traldf_hor .OR. ln_dynldf_hor )) THEN 
    866             IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    867  
    868             ! geopotential diffusion in s-coordinates on tracers and/or momentum 
    869             ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 
    870             ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 
    871  
    872             ! set the slope of diffusion to the slope of s-surfaces 
    873             !      ( c a u t i o n : minus sign as fsdep has positive value ) 
    874             DO jk = 1, jpk 
    875                DO jj = 2, jpjm1 
    876                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    877                      uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    878                      vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    879                      wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 
    880                      wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 
    881                   END DO 
    882                END DO 
    883             END DO 
    884             CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions 
    885             CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. ) 
    886          ENDIF 
     772         !!gm I no longer understand this..... 
     773!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 
     774!            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
     775! 
     776!            ! geopotential diffusion in s-coordinates on tracers and/or momentum 
     777!            ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 
     778!            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 
     779! 
     780!            ! set the slope of diffusion to the slope of s-surfaces 
     781!            !      ( c a u t i o n : minus sign as fsdep has positive value ) 
     782!            DO jk = 1, jpk 
     783!               DO jj = 2, jpjm1 
     784!                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     785!                     uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     786!                     vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     787!                     wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     788!                     wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     789!                  END DO 
     790!               END DO 
     791!            END DO 
     792!            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions 
     793!            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. ) 
     794!!gm         ENDIF 
    887795      ENDIF 
    888796      ! 
     
    890798      ! 
    891799   END SUBROUTINE ldf_slp_init 
    892  
    893 #else 
    894    !!------------------------------------------------------------------------ 
    895    !!   Dummy module :                 NO Rotation of lateral mixing tensor 
    896    !!------------------------------------------------------------------------ 
    897    LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag 
    898 CONTAINS 
    899    SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine 
    900       INTEGER, INTENT(in) :: kt 
    901       REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2 
    902       WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    903    END SUBROUTINE ldf_slp 
    904    SUBROUTINE ldf_slp_grif( kt )        ! Dummy routine 
    905       INTEGER, INTENT(in) :: kt 
    906       WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt 
    907    END SUBROUTINE ldf_slp_grif 
    908    SUBROUTINE ldf_slp_init              ! Dummy routine 
    909    END SUBROUTINE ldf_slp_init 
    910 #endif 
    911800 
    912801   !!====================================================================== 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r4624 r5758  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  ldftra  *** 
    4    !! Ocean physics:  lateral diffusivity coefficient  
     4   !! Ocean physics:  lateral diffusivity coefficients  
    55   !!===================================================================== 
    6    !! History :        ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
    7    !!   NEMO      1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    8    !!             2.0  ! 2005-11  (G. Madec)   
     6   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
     7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
     8   !!            2.0  ! 2005-11  (G. Madec)   
     9   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification, 
     10   !!                 !                                  add velocity dependent coefficient and optional read in file 
    911   !!---------------------------------------------------------------------- 
    1012 
    1113   !!---------------------------------------------------------------------- 
    1214   !!   ldf_tra_init : initialization, namelist read, and parameters control 
    13    !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization 
    14    !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization 
    15    !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization 
     15   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step  
     16   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices  
     17   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability) 
     18   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization 
     19   !!   ldf_eiv_dia  : diagnose the eddy induced velocity from the eiv streamfunction 
    1620   !!---------------------------------------------------------------------- 
    1721   USE oce             ! ocean dynamics and tracers 
    1822   USE dom_oce         ! ocean space and time domain 
    1923   USE phycst          ! physical constants 
    20    USE ldftra_oce      ! ocean tracer   lateral physics 
    21    USE ldfslp          ! ??? 
     24   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces 
     25   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases  
     26   USE diaar5, ONLY:   lk_diaar5 
     27   ! 
    2228   USE in_out_manager  ! I/O manager 
    23    USE ioipsl 
     29   USE iom             ! I/O module for ehanced bottom friction file 
    2430   USE lib_mpp         ! distribued memory computing library 
    2531   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     32   USE wrk_nemo        ! work arrays 
     33   USE timing          ! timing 
    2634 
    2735   IMPLICIT NONE 
    2836   PRIVATE 
    2937 
    30    PUBLIC   ldf_tra_init   ! called by opa.F90 
     38   PUBLIC   ldf_tra_init   ! called by nemogcm.F90 
     39   PUBLIC   ldf_tra        ! called by step.F90 
     40   PUBLIC   ldf_eiv_init   ! called by nemogcm.F90 
     41   PUBLIC   ldf_eiv        ! called by step.F90 
     42   PUBLIC   ldf_eiv_trp    ! called by traadv.F90 
     43   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90 
     44    
     45   !                                      !!* Namelist namtra_ldf : lateral mixing on tracers *  
     46   !                                       != Operator type =! 
     47   LOGICAL , PUBLIC ::   ln_traldf_lap          !: laplacian operator 
     48   LOGICAL , PUBLIC ::   ln_traldf_blp          !: bilaplacian operator 
     49   !                                       !=  Direction of action =! 
     50   LOGICAL , PUBLIC ::   ln_traldf_lev          !: iso-level direction 
     51   LOGICAL , PUBLIC ::   ln_traldf_hor          !: horizontal (geopotential) direction 
     52!   LOGICAL , PUBLIC ::   ln_traldf_iso         !: iso-neutral direction                    (see ldfslp) 
     53!   LOGICAL , PUBLIC ::   ln_traldf_triad       !: griffies triad scheme                    (see ldfslp) 
     54   LOGICAL , PUBLIC ::   ln_traldf_msc          !: Method of Stabilizing Correction  
     55!   LOGICAL , PUBLIC ::   ln_triad_iso          !: pure horizontal mixing in ML             (see ldfslp) 
     56!   LOGICAL , PUBLIC ::   ln_botmix_triad       !: mixing on bottom                         (see ldfslp) 
     57!   REAL(wp), PUBLIC ::   rn_sw_triad           !: =1/0 switching triad / all 4 triads used (see ldfslp) 
     58!   REAL(wp), PUBLIC ::   rn_slpmax             !: slope limit                              (see ldfslp) 
     59   !                                                 !=  Coefficients =! 
     60   INTEGER , PUBLIC ::   nn_aht_ijk_t           !:   ??????  !!gm 
     61   REAL(wp), PUBLIC ::   rn_aht_0               !:   laplacian lateral eddy diffusivity [m2/s] 
     62   REAL(wp), PUBLIC ::   rn_bht_0               !: bilaplacian lateral eddy diffusivity [m4/s] 
     63 
     64   !                                            !!* Namelist namtra_ldfeiv : eddy induced velocity param. * 
     65   !                                                 != Use/diagnose eiv =! 
     66   LOGICAL , PUBLIC ::   ln_ldfeiv                       !: eddy induced velocity flag 
     67   LOGICAL , PUBLIC ::   ln_ldfeiv_dia                   !: diagnose & output eiv streamfunction and velocity (IOM) 
     68   !                                                 !=  Coefficients =! 
     69   INTEGER , PUBLIC ::   nn_aei_ijk_t                    !: choice of time/space variation of the eiv coeff. 
     70   REAL(wp), PUBLIC ::   rn_aeiv_0                       !: eddy induced velocity coefficient [m2/s] 
     71    
     72   LOGICAL , PUBLIC ::   l_ldftra_time = .FALSE.   !: flag for time variation of the lateral eddy diffusivity coef. 
     73   LOGICAL , PUBLIC ::   l_ldfeiv_time = .FALSE.   ! flag for time variation of the eiv coef. 
     74 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtu, ahtv   !: eddy diffusivity coef. at U- and V-points   [m2/s] 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv   !: eddy induced velocity coeff.                [m2/s] 
     77 
     78   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4 
     79   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12 
    3180 
    3281   !! * Substitutions 
     
    3483#  include "vectopt_loop_substitute.h90" 
    3584   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     85   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    3786   !! $Id$ 
    3887   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4695      !! ** Purpose :   initializations of the tracer lateral mixing coeff. 
    4796      !! 
    48       !! ** Method  :   the Eddy diffusivity and eddy induced velocity ceoff. 
    49       !!      are defined as follows: 
    50       !!         default option   : constant coef. aht0, aeiv0 (namelist) 
    51       !!        'key_traldf_c1d': depth dependent coef. defined in  
    52       !!                            in ldf_tra_c1d routine 
    53       !!        'key_traldf_c2d': latitude and longitude dependent coef. 
    54       !!                            defined in ldf_tra_c2d routine 
    55       !!        'key_traldf_c3d': latitude, longitude, depth dependent coef. 
    56       !!                            defined in ldf_tra_c3d routine 
    57       !! 
    58       !!      N.B. User defined include files.  By default, 3d and 2d coef. 
    59       !!      are set to a constant value given in the namelist and the 1d 
    60       !!      coefficients are initialized to a hyperbolic tangent vertical 
    61       !!      profile. 
    62       !!---------------------------------------------------------------------- 
    63       INTEGER ::   ioptio               ! temporary integer 
    64       INTEGER ::   ios                  ! temporary integer 
    65       LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout 
    66       !!  
    67       NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  & 
    68          &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   & 
    69          &                 ln_traldf_grif , ln_traldf_gdia ,                  & 
    70          &                 ln_triad_iso   , ln_botmix_grif ,                  & 
    71          &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       & 
    72          &                 rn_slpmax      , rn_chsmag      ,    rn_smsh,      & 
    73          &                 rn_aht_m 
    74       !!---------------------------------------------------------------------- 
    75  
    76       !  Define the lateral tracer physics parameters 
    77       ! ============================================= 
    78      
    79  
     97      !! ** Method  : * the eddy diffusivity coef. specification depends on: 
     98      !! 
     99      !!    ln_traldf_lap = T     laplacian operator 
     100      !!    ln_traldf_blp = T   bilaplacian operator 
     101      !! 
     102      !!    nn_aht_ijk_t  =  0 => = constant 
     103      !!                  ! 
     104      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth  
     105      !!                  ! 
     106      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file 
     107      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 
     108      !!                  = 21    = F(i,j,t) = F(growth rate of baroclinic instability) 
     109      !!                  ! 
     110      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_diffusivity.nc' file 
     111      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10) 
     112      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator 
     113      !!                                                          or |u|e^3/12 bilaplacian operator ) 
     114      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init  
     115      !!             
     116      !! ** action  : ahtu, ahtv initialized once for all or l_ldftra_time set to true 
     117      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 
     118      !!---------------------------------------------------------------------- 
     119      INTEGER  ::   jk                ! dummy loop indices 
     120      INTEGER  ::   ierr, inum, ios   ! local integer 
     121      REAL(wp) ::   zah0              ! local scalar 
     122      ! 
     123      NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator 
     124         &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator 
     125         &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator 
     126         &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator 
     127         &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient 
     128      !!---------------------------------------------------------------------- 
     129      ! 
     130      !  Choice of lateral tracer physics 
     131      ! ================================= 
     132      ! 
    80133      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
    81134      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
    82135901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
    83  
     136      ! 
    84137      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
    85138      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    86139902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
    87140      IF(lwm) WRITE ( numond, namtra_ldf ) 
    88  
     141      ! 
    89142      IF(lwp) THEN                      ! control print 
    90143         WRITE(numout,*) 
     
    92145         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    93146         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
    94          WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap 
    95          WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap 
    96          WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level 
    97          WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor 
    98          WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso 
    99          WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif 
    100          WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia 
    101          WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0 
    102          WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0 
    103          WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0 
    104          WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax 
    105          WRITE(numout,*) '      pure lateral mixing in ML     ln_triad_iso    = ', ln_triad_iso 
    106          WRITE(numout,*) '      lateral mixing on bottom      ln_botmix_grif  = ', ln_botmix_grif 
     147         ! 
     148         WRITE(numout,*) '      type :' 
     149         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap 
     150         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp 
     151         ! 
     152         WRITE(numout,*) '      direction of action :' 
     153         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev 
     154         WRITE(numout,*) '         horizontal (geopotential)               ln_traldf_hor   = ', ln_traldf_hor 
     155         WRITE(numout,*) '         iso-neutral Madec operator              ln_traldf_iso   = ', ln_traldf_iso 
     156         WRITE(numout,*) '         iso-neutral triad operator              ln_traldf_triad = ', ln_traldf_triad 
     157         WRITE(numout,*) '            iso-neutral (Method of Stab. Corr.)  ln_traldf_msc   = ', ln_traldf_msc 
     158         WRITE(numout,*) '            maximum isoppycnal slope             rn_slpmax       = ', rn_slpmax 
     159         WRITE(numout,*) '            pure lateral mixing in ML            ln_triad_iso    = ', ln_triad_iso 
     160         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad 
     161         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad 
     162         ! 
     163         WRITE(numout,*) '      coefficients :' 
     164         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0 
     165         WRITE(numout,*) '         lateral eddy diffusivity (bilap case)   rn_bht_0        = ', rn_bht_0 
     166         WRITE(numout,*) '         type of time-space variation            nn_aht_ijk_t    = ', nn_aht_ijk_t 
     167      ENDIF 
     168      ! 
     169      !                                ! Parameter control 
     170      ! 
     171      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC 
     172         IF( .NOT.ln_traldf_msc )   CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' ) 
     173      ENDIF 
     174      ! 
     175      ! 
     176      !  Space/time variation of eddy coefficients  
     177      ! =========================================== 
     178      !                                               ! allocate the aht arrays 
     179      ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr ) 
     180      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
     181      ! 
     182      ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
     183      ahtv(:,:,jpk) = 0._wp 
     184      ! 
     185      !                                               ! value of eddy mixing coef. 
     186      IF    ( ln_traldf_lap ) THEN   ;   zah0 =      rn_aht_0        !   laplacian operator 
     187      ELSEIF( ln_traldf_blp ) THEN   ;   zah0 = ABS( rn_bht_0 )      ! bilaplacian operator 
     188      ELSE                                                           ! NO diffusion/viscosity operator 
     189         CALL ctl_warn( 'ldf_tra_init: No lateral diffusive operator used ' ) 
     190      ENDIF 
     191      ! 
     192      l_ldftra_time = .FALSE.                         ! no time variation except in case defined below 
     193      ! 
     194      IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN     ! only if a lateral diffusion operator is used 
     195         ! 
     196         SELECT CASE(  nn_aht_ijk_t  )                   ! Specification of space time variations of ehtu, ahtv 
     197         ! 
     198         CASE(   0  )      !==  constant  ==! 
     199            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
     200            ahtu(:,:,:) = zah0 * umask(:,:,:) 
     201            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
     202            ! 
     203         CASE(  10  )      !==  fixed profile  ==! 
     204            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
     205            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
     206            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
     207            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
     208            ! 
     209         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
     210            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 
     211            CALL iom_open( 'eddy_diffusivity.nc', inum ) 
     212            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 
     213            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
     214            CALL iom_close( inum ) 
     215            DO jk = 2, jpkm1 
     216               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     217               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     218            END DO 
     219            ! 
     220         CASE(  20  )      !== fixed horizontal shape  ==! 
     221            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 
     222            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     223            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     224            ! 
     225         CASE(  21  )      !==  time varying 2D field  ==! 
     226            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
     227            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
     228            IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0' 
     229            IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 
     230            IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S' 
     231            ! 
     232            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     233            ! 
     234            IF( ln_traldf_blp ) THEN 
     235               CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' ) 
     236            ENDIF 
     237            ! 
     238         CASE( -30  )      !== fixed 3D shape read in file  ==! 
     239            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 
     240            CALL iom_open( 'eddy_diffusivity.nc', inum ) 
     241            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 
     242            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
     243            CALL iom_close( inum ) 
     244            DO jk = 1, jpkm1 
     245               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
     246               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
     247            END DO 
     248            ! 
     249         CASE(  30  )      !==  fixed 3D shape  ==! 
     250            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     251            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     252            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     253            !                                                    ! reduction with depth 
     254            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
     255            ! 
     256         CASE(  31  )      !==  time varying 3D field  ==! 
     257            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )' 
     258            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12' 
     259            ! 
     260            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     261            ! 
     262         CASE DEFAULT 
     263            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht') 
     264         END SELECT 
     265         ! 
     266         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 
     267            ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 
     268            ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 
     269         ENDIF 
     270         ! 
     271      ENDIF 
     272      ! 
     273   END SUBROUTINE ldf_tra_init 
     274 
     275 
     276   SUBROUTINE ldf_tra( kt ) 
     277      !!---------------------------------------------------------------------- 
     278      !!                  ***  ROUTINE ldf_tra  *** 
     279      !!  
     280      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv) 
     281      !! 
     282      !! ** Method  :   time varying eddy diffusivity coefficients: 
     283      !! 
     284      !!    nn_aei_ijk_t = 21    aeiu, aeiv = F(i,j,  t) = F(growth rate of baroclinic instability) 
     285      !!                                                   with a reduction to 0 in vicinity of the Equator 
     286      !!    nn_aht_ijk_t = 21    ahtu, ahtv = F(i,j,  t) = F(growth rate of baroclinic instability) 
     287      !! 
     288      !!                 = 31    ahtu, ahtv = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator 
     289      !!                                                                     or |u|e^3/12 bilaplacian operator ) 
     290      !! 
     291      !! ** action  :   ahtu, ahtv   update at each time step    
     292      !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T)  
     293      !!---------------------------------------------------------------------- 
     294      INTEGER, INTENT(in) ::   kt   ! time step 
     295      ! 
     296      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     297      REAL(wp) ::   zaht, zaht_min, z1_f20       ! local scalar 
     298      !!---------------------------------------------------------------------- 
     299      ! 
     300      IF( nn_aei_ijk_t == 21 ) THEN       ! eddy induced velocity coefficients 
     301         !                                ! =F(growth rate of baroclinic instability) 
     302         !                                ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S 
     303         CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv ) 
     304         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel', kt 
     305      ENDIF 
     306      ! 
     307      SELECT CASE(  nn_aht_ijk_t  )       ! Eddy diffusivity coefficients 
     308      ! 
     309      CASE(  21  )       !==  time varying 2D field  ==!   = F( growth rate of baroclinic instability ) 
     310         !                                             !   min value rn_aht_0 / 10  
     311         !                                             !   max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21) 
     312         !                                             !   increase to rn_aht_0 within 20N-20S 
     313          
     314          
     315         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt ,nn_aei_ijk_t,  aeiuv max', kt,   & 
     316            &           nn_aei_ijk_t, MAXVAL( aeiu(:,:,1) ), MAXVAL( aeiv(:,:,1) ) 
     317 
     318 
     319         IF( nn_aei_ijk_t /= 21 ) THEN 
     320            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 
     321            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel  2', kt 
     322         ELSE 
     323            ahtu(:,:,1) = aeiu(:,:,1) 
     324            ahtv(:,:,1) = aeiv(:,:,1) 
     325            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ahtu=aeiu', kt 
     326         ENDIF 
     327          
     328         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ahtuv max ', kt, MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 
     329          
     330         ! 
     331         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)    
     332         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht 
     333          
     334         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , aht0 et ahtmin', kt, rn_aht_0, zaht_min 
     335          
     336         DO jj = 1, jpj 
     337            DO ji = 1, jpi 
     338               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 
     339               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min 
     340               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zaht  ) * vmask(ji,jj,1)     ! increase within 20S-20N 
     341            END DO 
     342         END DO 
     343         DO jk = 2, jpkm1                             ! deeper value = surface value 
     344            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     345            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     346         END DO 
     347         ! 
     348      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
     349         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12 
     350            DO jk = 1, jpkm1 
     351               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 
     352               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
     353            END DO 
     354         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 
     355            DO jk = 1, jpkm1 
     356               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
     357               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
     358            END DO 
     359         ENDIF 
     360         ! 
     361      END SELECT 
     362      ! 
     363      CALL iom_put( "ahtu_2d", ahtu(:,:,1) )   ! surface u-eddy diffusivity coeff. 
     364      CALL iom_put( "ahtv_2d", ahtv(:,:,1) )   ! surface v-eddy diffusivity coeff. 
     365      CALL iom_put( "ahtu_3d", ahtu(:,:,:) )   ! 3D      u-eddy diffusivity coeff. 
     366      CALL iom_put( "ahtv_3d", ahtv(:,:,:) )   ! 3D      v-eddy diffusivity coeff. 
     367      ! 
     368!!gm  : THE IF below is to be checked (comes from Seb) 
     369      IF( ln_ldfeiv ) THEN 
     370        CALL iom_put( "aeiu_2d", aeiu(:,:,1) )   ! surface u-EIV coeff. 
     371        CALL iom_put( "aeiv_2d", aeiv(:,:,1) )   ! surface v-EIV coeff. 
     372        CALL iom_put( "aeiu_3d", aeiu(:,:,:) )   ! 3D      u-EIV coeff. 
     373        CALL iom_put( "aeiv_3d", aeiv(:,:,:) )   ! 3D      v-EIV coeff. 
     374      ENDIF      
     375      ! 
     376   END SUBROUTINE ldf_tra 
     377 
     378 
     379   SUBROUTINE ldf_eiv_init 
     380      !!---------------------------------------------------------------------- 
     381      !!                  ***  ROUTINE ldf_eiv_init  *** 
     382      !! 
     383      !! ** Purpose :   initialization of the eiv coeff. from namelist choices. 
     384      !! 
     385      !! ** Method : 
     386      !! 
     387      !! ** Action :   aeiu , aeiv   : EIV coeff. at u- & v-points 
     388      !!               l_ldfeiv_time : =T if EIV coefficients vary with time 
     389      !!---------------------------------------------------------------------- 
     390      INTEGER  ::   jk                ! dummy loop indices 
     391      INTEGER  ::   ierr, inum, ios   ! local integer 
     392      ! 
     393      NAMELIST/namtra_ldfeiv/ ln_ldfeiv   , ln_ldfeiv_dia,   &    ! eddy induced velocity (eiv) 
     394         &                    nn_aei_ijk_t, rn_aeiv_0             ! eiv  coefficient 
     395      !!---------------------------------------------------------------------- 
     396      ! 
     397      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 
     398      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 
     399901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 
     400      ! 
     401      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param. 
     402      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 ) 
     403902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 
     404      WRITE ( numond, namtra_ldfeiv ) 
     405 
     406      IF(lwp) THEN                      ! control print 
    107407         WRITE(numout,*) 
    108       ENDIF 
    109  
    110       !                                ! convert DOCTOR namelist names into OLD names 
    111       aht0  = rn_aht_0 
    112       ahtb0 = rn_ahtb_0 
    113       aeiv0 = rn_aeiv_0 
    114  
    115       !                                ! Parameter control 
    116  
    117       ! ... Check consistency for type and direction : 
    118       !           ==> will be done in traldf module 
    119  
    120       ! ... Space variation of eddy coefficients 
    121       ioptio = 0 
    122 #if defined key_traldf_c3d 
    123       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)' 
    124       ioptio = ioptio + 1 
    125 #endif 
    126 #if defined key_traldf_c2d 
    127       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)' 
    128       ioptio = ioptio + 1 
    129 #endif 
    130 #if defined key_traldf_c1d 
    131       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    132       ioptio = ioptio + 1 
    133       IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' ) 
    134 #endif 
    135       IF( ioptio == 0 ) THEN 
    136           IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)' 
    137         ELSEIF( ioptio > 1 ) THEN 
    138            CALL ctl_stop('          use only one of the following keys:',   & 
    139              &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' ) 
    140       ENDIF 
    141  
    142       IF( ln_traldf_bilap ) THEN 
    143          IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    144          IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' ) 
     408         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 
     409         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     410         WRITE(numout,*) '   Namelist namtra_ldfeiv : ' 
     411         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv 
     412         WRITE(numout,*) '      eiv streamfunction & velocity diag.     ln_ldfeiv_dia = ', ln_ldfeiv_dia 
     413         WRITE(numout,*) '      eddy induced velocity coef.             rn_aeiv_0     = ', rn_aeiv_0 
     414         WRITE(numout,*) '      type of time-space variation            nn_aei_ijk_t  = ', nn_aei_ijk_t 
     415         WRITE(numout,*) 
     416      ENDIF 
     417      ! 
     418      IF( ln_ldfeiv .AND. ln_traldf_blp )   CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' ) 
     419 
     420      !                                 ! Parameter control 
     421      l_ldfeiv_time = .FALSE.     
     422      ! 
     423      IF( ln_ldfeiv ) THEN                         ! allocate the aei arrays 
     424         ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) 
     425         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays') 
     426         ! 
     427         SELECT CASE( nn_aei_ijk_t )               ! Specification of space time variations of eaiu, aeiv 
     428         ! 
     429         CASE(   0  )      !==  constant  ==! 
     430            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
     431            aeiu(:,:,:) = rn_aeiv_0 
     432            aeiv(:,:,:) = rn_aeiv_0 
     433            ! 
     434         CASE(  10  )      !==  fixed profile  ==! 
     435            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
     436            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
     437            aeiv(:,:,1) = rn_aeiv_0 
     438            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
     439            ! 
     440         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
     441            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 
     442            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 
     443            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 
     444            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
     445            CALL iom_close( inum ) 
     446            DO jk = 2, jpk 
     447               aeiu(:,:,jk) = aeiu(:,:,1) 
     448               aeiv(:,:,jk) = aeiv(:,:,1) 
     449            END DO 
     450            ! 
     451         CASE(  20  )      !== fixed horizontal shape  ==! 
     452            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 
     453            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
     454            ! 
     455         CASE(  21  )       !==  time varying 2D field  ==! 
     456            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
     457            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
     458            ! 
     459            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     460            ! 
     461         CASE( -30  )      !== fixed 3D shape read in file  ==! 
     462            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
     463            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 
     464            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu ) 
     465            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv ) 
     466            CALL iom_close( inum ) 
     467            ! 
     468         CASE(  30  )       !==  fixed 3D shape  ==! 
     469            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     470            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
     471            !                                                 ! reduction with depth 
     472            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
     473            ! 
     474         CASE DEFAULT 
     475            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei') 
     476         END SELECT 
     477         ! 
    145478      ELSE 
    146          IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    147          IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' ) 
    148       ENDIF 
    149  
    150  
    151       !  Lateral eddy diffusivity and eddy induced velocity coefficients 
    152       ! ================================================================ 
    153 #if defined key_traldf_c3d 
    154       CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth ) 
    155 #elif defined key_traldf_c2d 
    156       CALL ldf_tra_c2d( ll_print )      ! aht = 2D coef. = F( longitude, latitude ) 
    157 #elif defined key_traldf_c1d 
    158       CALL ldf_tra_c1d( ll_print )      ! aht = 1D coef. = F( depth ) 
    159 #else 
    160                                         ! Constant coefficients 
    161       IF(lwp)WRITE(numout,*) 
    162       IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0 
    163       IF( lk_traldf_eiv ) THEN 
    164          IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 
     479          IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed' 
     480          ln_ldfeiv_dia = .FALSE. 
     481      ENDIF 
     482      !                     
     483   END SUBROUTINE ldf_eiv_init 
     484 
     485 
     486   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv ) 
     487      !!---------------------------------------------------------------------- 
     488      !!                  ***  ROUTINE ldf_eiv  *** 
     489      !! 
     490      !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
     491      !!              growth rate of baroclinic instability. 
     492      !! 
     493      !! ** Method  :   coefficient function of the growth rate of baroclinic instability 
     494      !! 
     495      !! Reference : Treguier et al. JPO 1997   ; Held and Larichev JAS 1996 
     496      !!---------------------------------------------------------------------- 
     497      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index 
     498      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s] 
     499      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s] 
     500      ! 
     501      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     502      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars 
     503      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
     504      !!---------------------------------------------------------------------- 
     505      ! 
     506      IF( nn_timing == 1 )   CALL timing_start('ldf_eiv') 
     507      ! 
     508      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
     509      !       
     510      zn   (:,:) = 0._wp      ! Local initialization 
     511      zhw  (:,:) = 5._wp 
     512      zah  (:,:) = 0._wp 
     513      zross(:,:) = 0._wp 
     514      !                       ! Compute lateral diffusive coefficient at T-point 
     515      IF( ln_traldf_triad ) THEN 
     516         DO jk = 1, jpk 
     517            DO jj = 2, jpjm1 
     518               DO ji = 2, jpim1 
     519                  ! Take the max of N^2 and zero then take the vertical sum  
     520                  ! of the square root of the resulting N^2 ( required to compute  
     521                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     522                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
     523                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     524                  ! Compute elements required for the inverse time scale of baroclinic 
     525                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     526                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
     527                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     528                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 
     529                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
     530               END DO 
     531            END DO 
     532         END DO 
     533      ELSE 
     534         DO jk = 1, jpk 
     535            DO jj = 2, jpjm1 
     536               DO ji = 2, jpim1 
     537                  ! Take the max of N^2 and zero then take the vertical sum  
     538                  ! of the square root of the resulting N^2 ( required to compute  
     539                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     540                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
     541                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     542                  ! Compute elements required for the inverse time scale of baroclinic 
     543                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     544                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
     545                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     546                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     547                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 
     548                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
     549               END DO 
     550            END DO 
     551         END DO 
     552      END IF 
     553 
     554      DO jj = 2, jpjm1 
     555         DO ji = fs_2, fs_jpim1   ! vector opt. 
     556            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
     557            ! Rossby radius at w-point taken < 40km and  > 2km 
     558            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 
     559            ! Compute aeiw by multiplying Ro^2 and T^-1 
     560            zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1) 
     561         END DO 
     562      END DO 
     563 
     564!!gm      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2 
     565!!gm         DO jj = 2, jpjm1 
     566!!gm            DO ji = fs_2, fs_jpim1   ! vector opt. 
     567!!gm               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m) 
     568!!gm               IF( mbkt(ji,jj) <= 20 )   zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. ) 
     569!!gm            END DO 
     570!!gm         END DO 
     571!!gm      ENDIF 
     572 
     573      !                                         !==  Bound on eiv coeff.  ==! 
     574      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
     575      DO jj = 2, jpjm1 
     576         DO ji = fs_2, fs_jpim1   ! vector opt. 
     577            zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease 
     578            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
     579         END DO 
     580      END DO 
     581      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
     582      !                
     583      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==! 
     584         DO ji = fs_2, fs_jpim1   ! vector opt. 
     585            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
     586            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
     587         END DO  
     588      END DO  
     589      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
     590 
     591      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
     592         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 
     593         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
     594      END DO 
     595      !   
     596      CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
     597      ! 
     598      IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv') 
     599      ! 
     600   END SUBROUTINE ldf_eiv 
     601 
     602 
     603   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype ) 
     604      !!---------------------------------------------------------------------- 
     605      !!                  ***  ROUTINE ldf_eiv_trp  *** 
     606      !!  
     607      !! ** Purpose :   add to the input ocean transport the contribution of  
     608      !!              the eddy induced velocity parametrization. 
     609      !! 
     610      !! ** Method  :   The eddy induced transport is computed from a flux stream- 
     611      !!              function which depends on the slope of iso-neutral surfaces 
     612      !!              (see ldf_slp). For example, in the i-k plan :  
     613      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s] 
     614      !!                   Utr_eiv = - dk[psi_uw] 
     615      !!                   Vtr_eiv = + di[psi_uw] 
     616      !!                ln_ldfeiv_dia = T : output the associated streamfunction, 
     617      !!                                    velocity and heat transport (call ldf_eiv_dia) 
     618      !! 
     619      !! ** Action  : pun, pvn increased by the eiv transport 
     620      !!---------------------------------------------------------------------- 
     621      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
     622      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index 
     623      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     624      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s] 
     625      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s] 
     626      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s] 
     627      !! 
     628      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     629      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
     630      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
     631      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw 
     632      !!---------------------------------------------------------------------- 
     633      ! 
     634      IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp') 
     635      ! 
     636      CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
     637 
     638      IF( kt == kit000 )  THEN 
     639         IF(lwp) WRITE(numout,*) 
     640         IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 
     641         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component' 
     642      ENDIF 
     643 
    165644       
    166       ENDIF 
    167 #endif 
    168  
    169 #if defined key_traldf_smag && ! defined key_traldf_c3d 
    170         CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' ) 
    171 #endif 
    172 #if defined key_traldf_smag 
    173         IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION' 
    174         IF(lwp .AND. rn_smsh < 1)  WRITE(numout,*)' only  shear is used ' 
    175         IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' ) 
    176 #endif 
    177  
    178       ! 
    179    END SUBROUTINE ldf_tra_init 
    180  
    181 #if defined key_traldf_c3d 
    182 #   include "ldftra_c3d.h90" 
    183 #elif defined key_traldf_c2d 
    184 #   include "ldftra_c2d.h90" 
    185 #elif defined key_traldf_c1d 
    186 #   include "ldftra_c1d.h90" 
    187 #endif 
     645      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
     646      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
     647      ! 
     648      DO jk = 2, jpkm1 
     649         DO jj = 1, jpjm1 
     650            DO ji = 1, fs_jpim1   ! vector opt. 
     651               zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & 
     652                  &                                       * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk) 
     653               zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   & 
     654                  &                                       * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk) 
     655            END DO 
     656         END DO 
     657      END DO 
     658      ! 
     659      DO jk = 1, jpkm1 
     660         DO jj = 1, jpjm1 
     661            DO ji = 1, fs_jpim1   ! vector opt.                
     662               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
     663               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
     664            END DO 
     665         END DO 
     666      END DO 
     667      DO jk = 1, jpkm1 
     668         DO jj = 2, jpjm1 
     669            DO ji = fs_2, fs_jpim1   ! vector opt. 
     670               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
     671                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
     672            END DO 
     673         END DO 
     674      END DO 
     675      ! 
     676      !                              ! diagnose the eddy induced velocity and associated heat transport 
     677      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
     678      ! 
     679      CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
     680      ! 
     681      IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp') 
     682      ! 
     683    END SUBROUTINE ldf_eiv_trp 
     684 
     685 
     686   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw ) 
     687      !!---------------------------------------------------------------------- 
     688      !!                  ***  ROUTINE ldf_eiv_dia  *** 
     689      !! 
     690      !! ** Purpose :   diagnose the eddy induced velocity and its associated 
     691      !!              vertically integrated heat transport. 
     692      !! 
     693      !! ** Method : 
     694      !! 
     695      !!---------------------------------------------------------------------- 
     696      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
     697      ! 
     698      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     699      REAL(wp) ::   zztmp   ! local scalar 
     700      REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace 
     701      REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace 
     702      !!---------------------------------------------------------------------- 
     703      ! 
     704      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia') 
     705      ! 
     706      !                                                  !==  eiv stream function: output  ==! 
     707      CALL lbc_lnk( psi_uw, 'U', -1. )                         ! lateral boundary condition 
     708      CALL lbc_lnk( psi_vw, 'V', -1. ) 
     709      ! 
     710!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output 
     711!!gm      CALL iom_put( "psi_eiv_vw", psi_vw ) 
     712      ! 
     713      !                                                  !==  eiv velocities: calculate and output  ==! 
     714      CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
     715      ! 
     716      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
     717      ! 
     718      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
     719         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) ) 
     720      END DO 
     721      CALL iom_put( "uoce_eiv", zw3d ) 
     722      ! 
     723      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
     724         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) ) 
     725      END DO 
     726      CALL iom_put( "voce_eiv", zw3d ) 
     727      ! 
     728      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix] 
     729         DO jj = 2, jpjm1 
     730            DO ji = fs_2, fs_jpim1  ! vector opt. 
     731               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    & 
     732                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj) 
     733            END DO 
     734         END DO 
     735      END DO 
     736      CALL lbc_lnk( zw3d, 'T', 1. )      ! lateral boundary condition 
     737      CALL iom_put( "woce_eiv", zw3d ) 
     738      ! 
     739      CALL wrk_dealloc( jpi,jpj,jpk,   zw3d ) 
     740      !       
     741      ! 
     742      IF( lk_diaar5 ) THEN                               !==  eiv heat transport: calculate and output  ==! 
     743         CALL wrk_alloc( jpi,jpj,   zw2d ) 
     744         ! 
     745         zztmp = 0.5_wp * rau0 * rcp  
     746         zw2d(:,:) = 0._wp  
     747         DO jk = 1, jpkm1 
     748            DO jj = 2, jpjm1 
     749               DO ji = fs_2, fs_jpim1   ! vector opt. 
     750                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     751                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     752               END DO 
     753            END DO 
     754         END DO 
     755         CALL lbc_lnk( zw2d, 'U', -1. ) 
     756         CALL iom_put( "ueiv_heattr", zw2d )                  ! heat transport in i-direction 
     757         zw2d(:,:) = 0._wp  
     758         DO jk = 1, jpkm1 
     759            DO jj = 2, jpjm1 
     760               DO ji = fs_2, fs_jpim1   ! vector opt. 
     761                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
     762                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) )  
     763               END DO 
     764            END DO 
     765         END DO 
     766         CALL lbc_lnk( zw2d, 'V', -1. ) 
     767         CALL iom_put( "veiv_heattr", zw2d )                  !  heat transport in i-direction 
     768         ! 
     769         CALL wrk_dealloc( jpi,jpj,   zw2d ) 
     770      ENDIF 
     771      ! 
     772      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')       
     773      ! 
     774   END SUBROUTINE ldf_eiv_dia 
    188775 
    189776   !!====================================================================== 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5643 r5758  
    2828   USE sbcdcy           ! surface boundary condition: diurnal cycle 
    2929   USE sbcssm           ! surface boundary condition: sea-surface mean variables 
    30    USE sbcapr           ! surface boundary condition: atmospheric pressure 
    3130   USE sbcana           ! surface boundary condition: analytical formulation 
    3231   USE sbcflx           ! surface boundary condition: flux formulation 
     
    344343      !                                            !        forcing field computation         ! 
    345344      !                                            ! ---------------------------------------- ! 
    346       ! 
    347       IF ( .NOT. lk_bdy ) then 
    348          IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
    349       ENDIF 
    350                                                          ! (caution called before sbc_ssm) 
    351345      ! 
    352346      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5147 r5758  
    66   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
    77   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    8    !!            4.0  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation 
     8   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation 
     9   !!            4.0  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes  
     10   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option 
    911   !!---------------------------------------------------------------------- 
    1012 
     
    2224   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    2325   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    24    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    2526   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    2627   USE cla             ! cross land advection      (cla_traadv     routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   USE ldftra          ! lateral diffusion coefficient on tracers 
     29   USE ldfslp          ! Lateral diffusion: slopes of neutral surfaces 
    2830   ! 
    2931   USE in_out_manager  ! I/O manager 
     
    7476      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    7577      !!---------------------------------------------------------------------- 
    76       ! 
    7778      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7879      ! 
     
    8485      ! 
    8586      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     87      ! 
    8688      !                                          ! set time step 
    8789      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     
    9597      !                                               !==  effective transport  ==! 
    9698      DO jk = 1, jpkm1 
    97          zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    98          zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    99          zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk) 
     99         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
     100         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     101         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    100102      END DO 
    101103      ! 
     
    109111      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    110112      ! 
    111       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   & 
    112          &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary) 
    113       ! 
    114       IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary) 
    115       ! 
    116       CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport       
     113      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
     114         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary) 
     115      ! 
     116      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary) 
     117      ! 
     118      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport       
    117119      CALL iom_put( "vocetr_eff", zvn ) 
    118120      CALL iom_put( "wocetr_eff", zwn ) 
    119121      ! 
    120       IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
     122      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF  
    121123      ! 
    122124    
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r5120 r5758  
    44   !! Ocean Active tracers : lateral diffusive trends  
    55   !!===================================================================== 
    6    !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     6   !! History :  9.0  ! 2005-11  (G. Madec)  Original code 
     7   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     8   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg 
     9   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
     10   !!             -   ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of lateral diffusive operators 
    811   !!---------------------------------------------------------------------- 
    912 
     
    1114   !!   tra_ldf      : update the tracer trend with the lateral diffusion 
    1215   !!   tra_ldf_init : initialization, namelist read, and parameters control 
    13    !!       ldf_ano  : compute lateral diffusion for constant T-S profiles 
    14    !!---------------------------------------------------------------------- 
    15    USE oce             ! ocean dynamics and tracers 
    16    USE dom_oce         ! ocean space and time domain 
    17    USE phycst          ! physical constants 
    18    USE ldftra_oce      ! ocean tracer   lateral physics 
    19    USE ldfslp          ! ??? 
    20    USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    21    USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine) 
    22    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine) 
    23    USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    24    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine) 
    25    USE trd_oce         ! trends: ocean variables 
    26    USE trdtra          ! trends manager: tracers  
     16   !!---------------------------------------------------------------------- 
     17   USE oce           ! ocean dynamics and tracers 
     18   USE dom_oce       ! ocean space and time domain 
     19   USE phycst        ! physical constants 
     20   USE ldftra        ! lateral diffusion: eddy diffusivity & EIV coeff. 
     21   USE ldfslp        ! lateral diffusion: iso-neutral slope 
     22   USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine) 
     23   USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine) 
     24   USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine) 
     25   USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine) 
     26   USE trd_oce       ! trends: ocean variables 
     27   USE trdtra        ! ocean active tracers trends 
    2728   ! 
    28    USE prtctl          ! Print control 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_mpp         ! distribued memory computing library 
    31    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo        ! Memory allocation 
    33    USE timing          ! Timing 
     29   USE prtctl         ! Print control 
     30   USE in_out_manager ! I/O manager 
     31   USE lib_mpp        ! distribued memory computing library 
     32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     33   USE wrk_nemo       ! Memory allocation 
     34   USE timing         ! Timing 
    3435 
    3536   IMPLICIT NONE 
     
    3738 
    3839   PUBLIC   tra_ldf        ! called by step.F90  
    39    PUBLIC   tra_ldf_init   ! called by opa.F90  
     40   PUBLIC   tra_ldf_init   ! called by nemogcm.F90  
    4041   ! 
    4142   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    42  
    43    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile 
    44    !                                                               !  (key_traldf_ano only) 
    45  
     43    
    4644   !! * Substitutions 
    4745#  include "domzgr_substitute.h90" 
    4846#  include "vectopt_loop_substitute.h90" 
    4947   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     48   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    5149   !! $Id$  
    5250   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6563      !!---------------------------------------------------------------------- 
    6664      ! 
    67       IF( nn_timing == 1 )  CALL timing_start('tra_ldf') 
    68       ! 
    69       rldf = 1     ! For active tracers the  
    70  
     65      IF( nn_timing == 1 )   CALL timing_start('tra_ldf') 
     66      ! 
    7167      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    72          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
     68         CALL wrk_alloc( jpi,jpj,jpk,  ztrdt, ztrds )  
    7369         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    7470         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    7571      ENDIF 
    76  
    77       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    78       CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    79                                &                                   tsb, tsa, jpts        )  ! iso-level laplacian 
    80       CASE ( 1 )                                                                              ! rotated laplacian 
    81          IF( ln_traldf_grif ) THEN                                                           
    82                        CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator 
    83          ELSE                                                                                 
    84                        CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    85                                &                                  tsb, tsa, jpts, ahtb0 )      ! Madec operator 
    86          ENDIF 
    87       CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    88                                &                                   tsb, tsa, jpts        )  ! iso-level bilaplacian 
    89       CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap. 
     72      ! 
     73      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend 
     74      ! 
     75      CASE ( n_lap   )                                   ! laplacian: iso-level operator 
     76         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   ) 
    9077         ! 
    91       CASE ( -1 )                                ! esopa: test all possibility with control print 
    92          CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    93          &                                       tsb, tsa, jpts        )  
    94          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    95          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    96          IF( ln_traldf_grif ) THEN 
    97             CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
    98          ELSE 
    99             CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    100             &                                               tsb, tsa, jpts, ahtb0 )   
    101          ENDIF 
    102          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
    103          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    104          CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        & 
    105          &                                       tsb, tsa, jpts        )  
    106          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
    107          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    108          CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        )  
    109          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    110          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     78      CASE ( n_lap_i )                                   ! laplacian: standard iso-neutral operator (Madec) 
     79         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
     80         ! 
     81      CASE ( n_lap_it )                                  ! laplacian: triad iso-neutral operator (griffies) 
     82         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
     83         ! 
     84      CASE ( n_blp , n_blp_i , n_blp_it )                ! bilaplacian: iso-level & iso-neutral operators 
     85         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf ) 
    11186      END SELECT 
    11287 
    113 #if defined key_traldf_ano 
    114       tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity 
    115       tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:) 
    116 #endif 
    117  
    118       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     88      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    11989         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    12090         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    12191         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    12292         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    123          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    124       ENDIF 
    125       !                                          ! print mean trends (used for debugging) 
     93         CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt, ztrds )  
     94      ENDIF 
     95      !                                        !* print mean trends (used for debugging) 
    12696      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
    12797         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    12898      ! 
    129       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf') 
     99      IF( nn_timing == 1 )   CALL timing_stop('tra_ldf') 
    130100      ! 
    131101   END SUBROUTINE tra_ldf 
     
    139109      !! 
    140110      !! ** Method  :   set nldf from the namtra_ldf logicals 
    141       !!      nldf == -1   ESOPA test: ALL operators are used 
    142       !!      nldf ==  0   laplacian operator 
    143       !!      nldf ==  1   Rotated laplacian operator 
    144       !!      nldf ==  2   bilaplacian operator 
    145       !!      nldf ==  3   Rotated bilaplacian 
    146       !!---------------------------------------------------------------------- 
    147       INTEGER ::   ioptio, ierr         ! temporary integers  
    148       !!---------------------------------------------------------------------- 
    149  
    150       !  Define the lateral mixing oparator for tracers 
    151       ! =============================================== 
    152      
    153       IF(lwp) THEN                    ! Namelist print 
     111      !!---------------------------------------------------------------------- 
     112      INTEGER ::   ioptio, ierr   ! temporary integers  
     113      !!---------------------------------------------------------------------- 
     114      ! 
     115      IF(lwp) THEN                     ! Namelist print 
    154116         WRITE(numout,*) 
    155117         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 
     
    159121         WRITE(numout,*) 
    160122      ENDIF 
    161  
    162       !                               ! control the input 
     123      !                                ! control the input 
    163124      ioptio = 0 
    164       IF( ln_traldf_lap   )   ioptio = ioptio + 1 
    165       IF( ln_traldf_bilap )   ioptio = ioptio + 1 
    166       IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    167       IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion 
     125      IF( ln_traldf_lap )   ioptio = ioptio + 1 
     126      IF( ln_traldf_blp )   ioptio = ioptio + 1 
     127      IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
     128      IF( ioptio == 0   )   nldf = n_no_ldf     ! No lateral diffusion 
    168129      ioptio = 0 
    169       IF( ln_traldf_level )   ioptio = ioptio + 1 
    170       IF( ln_traldf_hor   )   ioptio = ioptio + 1 
    171       IF( ln_traldf_iso   )   ioptio = ioptio + 1 
    172       IF( ioptio >  1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    173  
    174       ! defined the type of lateral diffusion from ln_traldf_... logicals 
    175       ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
     130      IF( ln_traldf_lev )   ioptio = ioptio + 1 
     131      IF( ln_traldf_hor )   ioptio = ioptio + 1 
     132      IF( ln_traldf_iso )   ioptio = ioptio + 1 
     133      IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 
     134      ! 
     135      !                                ! defined the type of lateral diffusion from ln_traldf_... logicals 
    176136      ierr = 0 
    177       IF( ln_traldf_lap ) THEN       ! laplacian operator 
    178          IF ( ln_zco ) THEN                ! z-coordinate 
    179             IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
    180             IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    181             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    182          ENDIF 
    183          IF ( ln_zps ) THEN             ! zps-coordinate 
    184             IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
    185             IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    186             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    187          ENDIF 
    188          IF ( ln_sco ) THEN             ! s-coordinate 
    189             IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
    190             IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    191             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    192          ENDIF 
    193       ENDIF 
    194  
    195       IF( ln_traldf_bilap ) THEN      ! bilaplacian operator 
    196          IF ( ln_zco ) THEN                ! z-coordinate 
    197             IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
    198             IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    199             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    200          ENDIF 
    201          IF ( ln_zps ) THEN             ! zps-coordinate 
    202             IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed  
    203             IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    204             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    205          ENDIF 
    206          IF ( ln_sco ) THEN             ! s-coordinate 
    207             IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
    208             IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    209             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    210          ENDIF 
    211       ENDIF 
    212  
    213       IF( nldf == 3 )   CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' ) 
     137      IF( ln_traldf_lap ) THEN         ! laplacian operator 
     138         IF ( ln_zco ) THEN               ! z-coordinate 
     139            IF ( ln_traldf_lev   )   nldf = n_lap     ! iso-level = horizontal (no rotation) 
     140            IF ( ln_traldf_hor   )   nldf = n_lap     ! iso-level = horizontal (no rotation) 
     141            IF ( ln_traldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard  (   rotation) 
     142            IF ( ln_traldf_triad )   nldf = n_lap_it  ! iso-neutral: triad     (   rotation) 
     143         ENDIF 
     144         IF ( ln_zps ) THEN               ! z-coordinate with partial step 
     145            IF ( ln_traldf_lev   )   ierr = 1         ! iso-level not allowed  
     146            IF ( ln_traldf_hor   )   nldf = n_lap     ! horizontal (no rotation) 
     147            IF ( ln_traldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard (rotation) 
     148            IF ( ln_traldf_triad )   nldf = n_lap_it  ! iso-neutral: triad    (rotation) 
     149         ENDIF 
     150         IF ( ln_sco ) THEN               ! s-coordinate 
     151            IF ( ln_traldf_lev   )   nldf = n_lap     ! iso-level  (no rotation) 
     152            IF ( ln_traldf_hor   )   nldf = n_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
     153            IF ( ln_traldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard (rotation) 
     154            IF ( ln_traldf_triad )   nldf = n_lap_it  ! iso-neutral: triad    (rotation) 
     155         ENDIF 
     156      ENDIF 
     157      ! 
     158      IF( ln_traldf_blp ) THEN         ! bilaplacian operator 
     159         IF ( ln_zco ) THEN               ! z-coordinate 
     160            IF ( ln_traldf_lev   )   nldf = n_blp     ! iso-level = horizontal (no rotation) 
     161            IF ( ln_traldf_hor   )   nldf = n_blp     ! iso-level = horizontal (no rotation) 
     162            IF ( ln_traldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     163            IF ( ln_traldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     164         ENDIF 
     165         IF ( ln_zps ) THEN               ! z-coordinate with partial step 
     166            IF ( ln_traldf_lev   )   ierr = 1         ! iso-level not allowed  
     167            IF ( ln_traldf_hor   )   nldf = n_blp     ! horizontal (no rotation) 
     168            IF ( ln_traldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     169            IF ( ln_traldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     170         ENDIF 
     171         IF ( ln_sco ) THEN               ! s-coordinate 
     172            IF ( ln_traldf_lev   )   nldf = n_blp     ! iso-level  (no rotation) 
     173            IF ( ln_traldf_hor   )   nldf = n_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
     174            IF ( ln_traldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     175            IF ( ln_traldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     176         ENDIF 
     177      ENDIF 
     178      ! 
    214179      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    215       IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    216       IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   & 
    217            CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    218            &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    219       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    220          IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    221          l_traldf_rot = .TRUE.                 ! needed for trazdf_imp 
    222       ENDIF 
    223  
    224       IF( lk_esopa ) THEN 
    225          IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    226          nldf = -1 
    227       ENDIF 
    228  
     180      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    & 
     181           &            CALL ctl_stop( '          eddy induced velocity on tracers requires isopycnal',    & 
     182           &                                                                    ' laplacian diffusion' ) 
     183      IF(  nldf == n_lap_i .OR. nldf == n_lap_it .OR. & 
     184         & nldf == n_blp_i .OR. nldf == n_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
     185      ! 
    229186      IF(lwp) THEN 
    230187         WRITE(numout,*) 
    231          IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion' 
    232          IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used' 
    233          IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator' 
    234          IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator' 
    235          IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator' 
    236          IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian' 
    237       ENDIF 
    238  
    239       ! Reference T & S diffusivity (if necessary) 
    240       ! =========================== 
    241       CALL ldf_ano 
     188         IF( nldf == n_no_ldf )   WRITE(numout,*) '          NO lateral diffusion' 
     189         IF( nldf == n_lap    )   WRITE(numout,*) '          laplacian iso-level operator' 
     190         IF( nldf == n_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
     191         IF( nldf == n_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
     192         IF( nldf == n_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator' 
     193         IF( nldf == n_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
     194         IF( nldf == n_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     195      ENDIF 
    242196      ! 
    243197   END SUBROUTINE tra_ldf_init 
    244  
    245 #if defined key_traldf_ano 
    246    !!---------------------------------------------------------------------- 
    247    !!   'key_traldf_ano'               T & S lateral diffusion on anomalies 
    248    !!---------------------------------------------------------------------- 
    249  
    250    SUBROUTINE ldf_ano 
    251       !!---------------------------------------------------------------------- 
    252       !!                  ***  ROUTINE ldf_ano  *** 
    253       !! 
    254       !! ** Purpose :   initializations of  
    255       !!---------------------------------------------------------------------- 
    256       ! 
    257       USE zdf_oce         ! vertical mixing 
    258       USE trazdf          ! vertical mixing: double diffusion 
    259       USE zdfddm          ! vertical mixing: double diffusion 
    260       ! 
    261       INTEGER  ::   jk              ! Dummy loop indice 
    262       INTEGER  ::   ierr            ! local integer 
    263       LOGICAL  ::   llsave          ! local logical 
    264       REAL(wp) ::   zt0, zs0, z12   ! local scalar 
    265       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt      
    266       !!---------------------------------------------------------------------- 
    267       ! 
    268       IF( nn_timing == 1 )  CALL timing_start('ldf_ano') 
    269       ! 
    270       CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )  
    271       ! 
    272  
    273       IF(lwp) THEN 
    274          WRITE(numout,*) 
    275          WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies' 
    276          WRITE(numout,*) '~~~~~~~~~~~' 
    277       ENDIF 
    278  
    279       !                              ! allocate trabbl arrays 
    280       ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr ) 
    281       IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    282       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' ) 
    283  
    284       ! defined the T & S reference profiles 
    285       ! ------------------------------------ 
    286       zt0 =10.e0                               ! homogeneous ocean 
    287       zs0 =35.e0 
    288       zt_ref(:,:,:) = 10.0 * tmask(:,:,:) 
    289       zs_ref(:,:,:) = 35.0 * tmask(:,:,:) 
    290       IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0 
    291  
    292       ! Initialisation of gtui/gtvi in case of no cavity 
    293       IF ( .NOT. ln_isfcav ) THEN 
    294          gtui(:,:,:) = 0.0_wp 
    295          gtvi(:,:,:) = 0.0_wp 
    296       END IF 
    297       !                                        ! T & S profile (to be coded +namelist parameter 
    298  
    299       ! prepare the ldf computation 
    300       ! --------------------------- 
    301       llsave = l_trdtra 
    302       l_trdtra = .false.      ! desactivate trend computation 
    303       t0_ldf(:,:,:) = 0.e0 
    304       s0_ldf(:,:,:) = 0.e0 
    305       ztb   (:,:,:) = tsb (:,:,:,jp_tem) 
    306       zsb   (:,:,:) = tsb (:,:,:,jp_sal) 
    307       ua    (:,:,:) = tsa (:,:,:,jp_tem) 
    308       va    (:,:,:) = tsa (:,:,:,jp_sal) 
    309       zavt  (:,:,:) = avt(:,:,:) 
    310       IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' ) 
    311       ! set tb, sb to reference values and avr to zero 
    312       tsb (:,:,:,jp_tem) = zt_ref(:,:,:) 
    313       tsb (:,:,:,jp_sal) = zs_ref(:,:,:) 
    314       tsa (:,:,:,jp_tem) = 0.e0 
    315       tsa (:,:,:,jp_sal) = 0.e0 
    316       avt(:,:,:)         = 0.e0 
    317  
    318       ! Compute the ldf trends 
    319       ! ---------------------- 
    320       CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init) 
    321       CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init) 
    322  
    323       ! finalise the computation and recover all arrays 
    324       ! ----------------------------------------------- 
    325       l_trdtra = llsave 
    326       z12 = 2.e0 
    327       IF( neuler == 1)   z12 = 1.e0 
    328       IF( ln_zdfexp ) THEN      ! ta,sa are the trends 
    329          t0_ldf(:,:,:) = tsa(:,:,:,jp_tem) 
    330          s0_ldf(:,:,:) = tsa(:,:,:,jp_sal) 
    331       ELSE 
    332          DO jk = 1, jpkm1 
    333             t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) ) 
    334             s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) ) 
    335          END DO 
    336       ENDIF 
    337       tsb(:,:,:,jp_tem) = ztb (:,:,:) 
    338       tsb(:,:,:,jp_sal) = zsb (:,:,:) 
    339       tsa(:,:,:,jp_tem) = ua  (:,:,:) 
    340       tsa(:,:,:,jp_sal) = va  (:,:,:) 
    341       avt(:,:,:)        = zavt(:,:,:) 
    342       ! 
    343       CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )  
    344       ! 
    345       IF( nn_timing == 1 )  CALL timing_stop('ldf_ano') 
    346       ! 
    347    END SUBROUTINE ldf_ano 
    348  
    349 #else 
    350    !!---------------------------------------------------------------------- 
    351    !!   default option :   Dummy code   NO T & S background profiles 
    352    !!---------------------------------------------------------------------- 
    353    SUBROUTINE ldf_ano 
    354       IF(lwp) THEN 
    355          WRITE(numout,*) 
    356          WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields' 
    357          WRITE(numout,*) '~~~~~~~~~~~' 
    358       ENDIF 
    359    END SUBROUTINE ldf_ano 
    360 #endif 
    361198 
    362199   !!====================================================================== 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5737 r5758  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History :  OPA  !  1994-08  (G. Madec, M. Imbard) 
    7    !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf 
    8    !!            NEMO !  2002-08  (G. Madec)  Free form, F90 
    9    !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-) 
    10    !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
     6   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard) 
     7   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf 
     8   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90 
     9   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-) 
     10   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
     11   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification 
     12   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
    1113   !!---------------------------------------------------------------------- 
    12 #if   defined key_ldfslp   ||   defined key_esopa 
     14 
    1315   !!---------------------------------------------------------------------- 
    14    !!   'key_ldfslp'               slope of the lateral diffusive direction 
    15    !!---------------------------------------------------------------------- 
    16    !!   tra_ldf_iso  : update the tracer trend with the horizontal  
    17    !!                  component of a iso-neutral laplacian operator 
    18    !!                  and with the vertical part of 
    19    !!                  the isopycnal or geopotential s-coord. operator  
     16   !!   tra_ldf_iso  : update the tracer trend with the horizontal component of a iso-neutral laplacian operator 
     17   !!                  and with the vertical part of the isopycnal or geopotential s-coord. operator  
    2018   !!---------------------------------------------------------------------- 
    2119   USE oce             ! ocean dynamics and active tracers 
     
    2321   USE trc_oce         ! share passive tracers/Ocean variables 
    2422   USE zdf_oce         ! ocean vertical physics 
    25    USE ldftra_oce      ! ocean active tracers: lateral physics 
     23   USE ldftra          ! lateral diffusion: tracer eddy coefficients 
    2624   USE ldfslp          ! iso-neutral slopes 
    2725   USE diaptr          ! poleward transport diagnostics 
     26   ! 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE iom             ! I/O library 
     
    4039   !! * Substitutions 
    4140#  include "domzgr_substitute.h90" 
    42 #  include "ldftra_substitute.h90" 
    4341#  include "vectopt_loop_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     43   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4644   !! $Id$ 
    4745   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4947CONTAINS 
    5048 
    51    SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,              & 
    52       &                                pgui, pgvi,                    & 
    53       &                                ptb, pta, kjpt, pahtb0 ) 
     49  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
     50      &                                                   pgui, pgvi,   & 
     51      &                                       ptb , ptbb, pta , kjpt, kpass ) 
    5452      !!---------------------------------------------------------------------- 
    5553      !!                  ***  ROUTINE tra_ldf_iso  *** 
     
    6664      !! 
    6765      !!      1st part :  masked horizontal derivative of T  ( di[ t ] ) 
    68       !!      ========    with partial cell update if ln_zps=T. 
     66      !!      ========    with partial cell update if ln_zps=T 
     67      !!                  with top     cell update if ln_isfcav 
    6968      !! 
    7069      !!      2nd part :  horizontal fluxes of the lateral mixing operator 
    7170      !!      ========     
    72       !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 
    73       !!               - aht      e2u*uslp    dk[ mi(mk(tb)) ] 
    74       !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ] 
    75       !!               - aht      e2u*vslp    dk[ mj(mk(tb)) ] 
     71      !!         zftu =  pahu e2u*e3u/e1u di[ tb ] 
     72      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ] 
     73      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ] 
     74      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ] 
    7675      !!      take the horizontal divergence of the fluxes: 
    77       !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
     76      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
    7877      !!      Add this trend to the general trend (ta,sa): 
    7978      !!         ta = ta + difft 
     
    8281      !!      ========  (excluding the vertical flux proportional to dk[t] ) 
    8382      !!      vertical fluxes associated with the rotated lateral mixing: 
    84       !!         zftw =-aht { e2t*wslpi di[ mi(mk(tb)) ] 
    85       !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  } 
     83      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ] 
     84      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  } 
    8685      !!      take the horizontal divergence of the fluxes: 
    87       !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
     86      !!         difft = 1/(e1e2t*e3t) dk[ zftw ] 
    8887      !!      Add this trend to the general trend (ta,sa): 
    8988      !!         pta = pta + difft 
     
    9190      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9291      !!---------------------------------------------------------------------- 
    93       USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
    94       ! 
    9592      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    96       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     93      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    9794      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    9895      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    99       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv    ! tracer gradient at pstep levels 
    100       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgui, pgvi   ! tracer gradient at pstep levels 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    103       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
     96      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     98      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     99      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     100      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    104103      ! 
    105104      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    106       INTEGER  ::  ikt 
    107       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    108       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    109       REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    110       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    111       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
     105      INTEGER  ::  ierr             ! local integer 
     106      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars 
     107      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
     108      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
     109#if defined key_diaar5 
     110      REAL(wp) ::   zztmp   ! local scalar 
     111#endif 
     112      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
     113      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    112114      !!---------------------------------------------------------------------- 
    113115      ! 
    114116      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    115117      ! 
    116       CALL wrk_alloc( jpi, jpj,      z2d )  
    117       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
    118       ! 
    119  
     118      CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d )  
     119      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  )  
     120      ! 
    120121      IF( kt == kit000 )  THEN 
    121122         IF(lwp) WRITE(numout,*) 
    122123         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    123124         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     125         ! 
     126         akz     (:,:,:) = 0._wp       
     127         ah_wslp2(:,:,:) = 0._wp 
     128      ENDIF 
     129      ! 
     130      !                                               ! set time step size (Euler/Leapfrog) 
     131      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdttra(1)      ! at nit000   (Euler) 
     132      ELSE                                        ;   z2dt = 2.* rdttra(1)      !             (Leapfrog) 
     133      ENDIF 
     134      z1_2dt = 1._wp / z2dt 
     135      ! 
     136      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
     137      ELSE                    ;   zsign = -1._wp 
     138      ENDIF 
     139          
     140          
     141      !!---------------------------------------------------------------------- 
     142      !!   0 - calculate  ah_wslp2 and akz 
     143      !!---------------------------------------------------------------------- 
     144      ! 
     145      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
     146         ! 
     147         DO jk = 2, jpkm1 
     148            DO jj = 2, jpjm1 
     149               DO ji = fs_2, fs_jpim1   ! vector opt. 
     150                  ! 
     151                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     152                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
     153                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     154                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
     155                     ! 
     156                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    & 
     157                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku 
     158                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    & 
     159                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv 
     160                     ! 
     161                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     162                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 
     163               END DO 
     164            END DO 
     165         END DO 
     166         ! 
     167         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
     168            DO jk = 2, jpkm1 
     169               DO jj = 2, jpjm1 
     170                  DO ji = fs_2, fs_jpim1 
     171                     akz(ji,jj,jk) = 0.25_wp * (                                                                     & 
     172                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   & 
     173                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   & 
     174                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   & 
     175                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   ) 
     176                  END DO 
     177               END DO 
     178            END DO 
     179            ! 
     180            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
     181               DO jk = 2, jpkm1 
     182                  DO jj = 1, jpjm1 
     183                     DO ji = 1, fs_jpim1 
     184                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
     185                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  ) 
     186                     END DO 
     187                  END DO 
     188               END DO 
     189            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
     190               DO jk = 2, jpkm1 
     191                  DO jj = 1, jpjm1 
     192                     DO ji = 1, fs_jpim1 
     193                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     194                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     195                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     196                     END DO 
     197                  END DO 
     198               END DO 
     199           ENDIF 
     200           ! 
     201         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
     202            akz(:,:,:) = ah_wslp2(:,:,:)       
     203         ENDIF 
    124204      ENDIF 
    125205      ! 
     
    131211         !!   I - masked horizontal derivative  
    132212         !!---------------------------------------------------------------------- 
    133          !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 
    134          zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0 
    135          zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0 
     213!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
     214         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
     215         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
    136216         !!end 
    137217 
     
    145225            END DO 
    146226         END DO 
    147  
    148          ! partial cell correction 
    149          IF( ln_zps ) THEN      ! partial steps correction at the last ocean level  
    150             DO jj = 1, jpjm1 
     227         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
     228            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell) 
    151229               DO ji = 1, fs_jpim1   ! vector opt. 
    152 ! IF useless if zpshde defines pgu everywhere 
     230!!gm  the following anonymous remark is to considered: ! IF useless if zpshde defines pgu everywhere 
    153231                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)           
    154232                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    155233               END DO 
    156234            END DO 
     235            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
     236               DO jj = 1, jpjm1 
     237                  DO ji = 1, fs_jpim1   ! vector opt. 
     238                     IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)           
     239                     IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)      
     240                  END DO 
     241               END DO 
     242            ENDIF 
    157243         ENDIF 
    158          IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity 
    159             DO jj = 1, jpjm1 
     244 
     245         !!---------------------------------------------------------------------- 
     246         !!   II - horizontal trend  (full) 
     247         !!---------------------------------------------------------------------- 
     248         ! 
     249         DO jk = 1, jpkm1                                 ! Horizontal slab 
     250            ! 
     251            !                             !== Vertical tracer gradient 
     252            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
     253            ! 
     254            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
     255            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
     256            ENDIF 
     257!!gm I don't understand why we should need this.... since wmask is used instead of tmask 
     258!         IF ( ln_isfcav ) THEN 
     259!            DO jj = 1, jpj 
     260!               DO ji = 1, jpi   ! vector opt. 
     261!                  ikt = mikt(ji,jj) ! surface level 
     262!                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 
     263!                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 
     264!               END DO 
     265!            END DO 
     266!         END IF 
     267!!gm  
     268 
     269            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    160270               DO ji = 1, fs_jpim1   ! vector opt. 
    161                   IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)           
    162                   IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)      
    163                END DO 
    164             END DO 
    165          END IF 
    166  
    167          !!---------------------------------------------------------------------- 
    168          !!   II - horizontal trend  (full) 
    169          !!---------------------------------------------------------------------- 
    170 !!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t )  
    171             ! 1. Vertical tracer gradient at level jk and jk+1 
    172             ! ------------------------------------------------ 
    173          !  
    174          ! interior value  
    175          DO jk = 2, jpkm1                
    176             DO jj = 1, jpj 
    177                DO ji = 1, jpi   ! vector opt. 
    178                   zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 
    179                   ! 
    180                   zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk) 
    181                END DO 
    182             END DO 
    183          END DO 
    184          ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    185          zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 
    186          zdkt (:,:,1) = zdk1t(:,:,1) 
    187          IF ( ln_isfcav ) THEN 
    188             DO jj = 1, jpj 
    189                DO ji = 1, jpi   ! vector opt. 
    190                   ikt = mikt(ji,jj) ! surface level 
    191                   zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 
    192                   zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 
    193                END DO 
    194             END DO 
    195          END IF 
    196  
    197          ! 2. Horizontal fluxes 
    198          ! --------------------    
    199          DO jk = 1, jpkm1 
    200             DO jj = 1 , jpjm1 
    201                DO ji = 1, fs_jpim1   ! vector opt. 
    202                   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    203                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     271                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     272                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    204273                  ! 
    205274                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
     
    209278                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    210279                  ! 
    211                   zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    212                   zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
     280                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
     281                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    213282                  ! 
    214283                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
    215                      &              + zcof1 * (  zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk)      & 
    216                      &                         + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk) 
     284                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
     285                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk) 
    217286                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    218                      &              + zcof2 * (  zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk)      & 
    219                      &                         + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                   
    220                END DO 
    221             END DO 
    222  
    223             ! II.4 Second derivative (divergence) and add to the general trend 
    224             ! ---------------------------------------------------------------- 
    225             DO jj = 2 , jpjm1 
     287                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
     288                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                   
     289               END DO 
     290            END DO 
     291            ! 
     292            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    226293               DO ji = fs_2, fs_jpim1   ! vector opt. 
    227                   zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    228                   ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    229                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    230                END DO 
    231             END DO 
    232             !                                          ! =============== 
     294                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
     295                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
     296                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
     297               END DO 
     298            END DO 
    233299         END DO                                        !   End of slab   
    234          !                                             ! =============== 
    235          ! 
    236          ! "Poleward" diffusive heat or salt transports (T-S case only) 
    237          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    238             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    239             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    240             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    241          ENDIF 
    242   
    243          IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
    244            ! 
    245            IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    246                z2d(:,:) = 0._wp  
    247                DO jk = 1, jpkm1 
    248                   DO jj = 2, jpjm1 
    249                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    250                         z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
    251                      END DO 
    252                   END DO 
    253                END DO 
    254                z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    255                CALL lbc_lnk( z2d, 'U', -1. ) 
    256                CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    257                ! 
    258                z2d(:,:) = 0._wp  
    259                DO jk = 1, jpkm1 
    260                   DO jj = 2, jpjm1 
    261                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    262                         z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
    263                      END DO 
    264                   END DO 
    265                END DO 
    266                z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    267                CALL lbc_lnk( z2d, 'V', -1. ) 
    268                CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    269             END IF 
    270             ! 
    271          ENDIF 
    272  
    273          !!---------------------------------------------------------------------- 
    274          !!   III - vertical trend of T & S (extra diagonal terms only) 
    275          !!---------------------------------------------------------------------- 
    276           
    277          ! Local constant initialization 
    278          ! ----------------------------- 
    279          ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0 
     300 
     301 
     302         !!---------------------------------------------------------------------- 
     303         !!   III - vertical trend (full) 
     304         !!---------------------------------------------------------------------- 
     305          
     306         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp 
    280307          
    281308         ! Vertical fluxes 
     
    283310          
    284311         ! Surface and bottom vertical fluxes set to zero 
    285          ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0 
     312         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    286313          
    287314         ! interior (2=<jk=<jpk-1) 
     
    289316            DO jj = 2, jpjm1 
    290317               DO ji = fs_2, fs_jpim1   ! vector opt. 
    291                   zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk) 
    292                   ! 
    293                   zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      & 
    294                      &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  ) 
    295                   zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      & 
    296                      &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  ) 
    297                   ! 
    298                   zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 
    299                   zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
     318                  ! 
     319                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     320                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
     321                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     322                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
     323                     ! 
     324                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    & 
     325                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku 
     326                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    & 
     327                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv 
     328                     ! 
     329                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked 
     330                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
    300331                  ! 
    301332                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      & 
     
    306337            END DO 
    307338         END DO 
    308           
    309           
    310          ! I.5 Divergence of vertical fluxes added to the general tracer trend 
    311          ! ------------------------------------------------------------------- 
    312          DO jk = 1, jpkm1 
     339         ! 
     340         !                                !==  add the vertical 33 flux  ==! 
     341         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
     342            DO jk = 2, jpkm1        
     343               DO jj = 1, jpjm1 
     344                  DO ji = fs_2, fs_jpim1 
     345                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   & 
     346                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
     347                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     348                  END DO 
     349               END DO 
     350            END DO 
     351            ! 
     352         ELSE                                   ! bilaplacian  
     353            SELECT CASE( kpass ) 
     354            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
     355               DO jk = 2, jpkm1  
     356                  DO jj = 1, jpjm1 
     357                     DO ji = fs_2, fs_jpim1 
     358                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
     359                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
     360                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk) 
     361                     END DO 
     362                  END DO 
     363               END DO  
     364            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     365               DO jk = 2, jpkm1  
     366                  DO jj = 1, jpjm1 
     367                     DO ji = fs_2, fs_jpim1 
     368                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     369                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
     370                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     371                     END DO 
     372                  END DO 
     373               END DO 
     374            END SELECT 
     375         ENDIF 
     376         !          
     377         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    313378            DO jj = 2, jpjm1 
    314379               DO ji = fs_2, fs_jpim1   ! vector opt. 
    315                   zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    316                   ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    317                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     380                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
     381                     &                                        / (  e1e2t(ji,jj) * fse3t_n(ji,jj,jk)  ) 
    318382               END DO 
    319383            END DO 
    320384         END DO 
    321385         ! 
    322       END DO 
    323       ! 
    324       CALL wrk_dealloc( jpi, jpj, z2d )  
    325       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
     386         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     387             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==! 
     388            ! 
     389            !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
     390            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     391               ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     392               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     393               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     394            ENDIF 
     395            ! 
     396            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     397              ! 
     398              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     399                  z2d(:,:) = zftu(ji,jj,1)  
     400                  DO jk = 2, jpkm1 
     401                     DO jj = 2, jpjm1 
     402                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     403                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     404                        END DO 
     405                     END DO 
     406                  END DO 
     407!!gm CAUTION I think there is an error of sign when using BLP operator.... 
     408!!gm         a multiplication by zsign is required (to be checked twice !) 
     409                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     410                  CALL lbc_lnk( z2d, 'U', -1. ) 
     411                  CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     412                  ! 
     413                  z2d(:,:) = zftv(ji,jj,1)  
     414                  DO jk = 2, jpkm1 
     415                     DO jj = 2, jpjm1 
     416                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     417                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     418                        END DO 
     419                     END DO 
     420                  END DO 
     421                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     422                  CALL lbc_lnk( z2d, 'V', -1. ) 
     423                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     424               END IF 
     425               ! 
     426            ENDIF 
     427            ! 
     428         ENDIF                                                    !== end pass selection  ==! 
     429         ! 
     430         !                                                        ! =============== 
     431      END DO                                                      ! end tracer loop 
     432      !                                                           ! =============== 
     433      ! 
     434      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
     435      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  )  
    326436      ! 
    327437      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
    328438      ! 
    329439   END SUBROUTINE tra_ldf_iso 
    330  
    331 #else 
    332    !!---------------------------------------------------------------------- 
    333    !!   default option :   Dummy code   NO rotation of the diffusive tensor 
    334    !!---------------------------------------------------------------------- 
    335 CONTAINS 
    336    SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, pgui, pgvi, ptb, pta, kjpt, pahtb0 )      ! Empty routine 
    337       INTEGER:: kt, kit000 
    338       CHARACTER(len=3) ::   cdtype 
    339       REAL, DIMENSION(:,:,:) ::   pgu, pgv, pgui, pgvi    ! tracer gradient at pstep levels 
    340       REAL, DIMENSION(:,:,:,:) ::   ptb, pta 
    341       WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   & 
    342          &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 
    343    END SUBROUTINE tra_ldf_iso 
    344 #endif 
    345440 
    346441   !!============================================================================== 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5737 r5758  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  traldf_lap  *** 
    4    !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
     4   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian) 
    55   !!============================================================================== 
    6    !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code 
    7    !!                 !  91-11  (G. Madec) 
    8    !!                 !  95-11  (G. Madec)  suppress volumetric scale factors 
    9    !!                 !  96-01  (G. Madec)  statement function for e3 
    10    !!            NEMO !  02-06  (G. Madec)  F90: Free form and module 
    11    !!            1.0  !  04-08  (C. Talandier) New trends organization 
    12    !!                 !  05-11  (G. Madec)  add zps case 
    13    !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC 
     6   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code 
     7   !!                 ! 1991-11  (G. Madec) 
     8   !!                 ! 1995-11  (G. Madec)  suppress volumetric scale factors 
     9   !!                 ! 1996-01  (G. Madec)  statement function for e3 
     10   !!            NEMO ! 2002-06  (G. Madec)  F90: Free form and module 
     11   !!            1.0  ! 2004-08  (C. Talandier) New trends organization 
     12   !!                 ! 2005-11  (G. Madec)  add zps case 
     13   !!            3.0  ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
     14   !!            3.7  ! 2014-01  (G. Madec, S. Masson) re-entrant laplacian  
    1415   !!---------------------------------------------------------------------- 
    1516 
    1617   !!---------------------------------------------------------------------- 
    17    !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion 
    18    !!                 using a iso-level harmonic (laplacien) operator. 
     18   !!   tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator 
     19   !!   tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 
    1920   !!---------------------------------------------------------------------- 
    2021   USE oce             ! ocean dynamics and active tracers 
    2122   USE dom_oce         ! ocean space and time domain 
    22    USE ldftra_oce      ! ocean active tracers: lateral physics 
    23    USE in_out_manager  ! I/O manager 
     23   USE ldftra          ! lateral physics: eddy diffusivity 
    2424   USE diaptr          ! poleward transport diagnostics 
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
    26    USE lib_mpp         ! MPP library 
     26   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
     27   ! 
     28   USE in_out_manager  ! I/O manager 
     29   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     30   USE lib_mpp         ! distribued memory computing library 
    2731   USE timing          ! Timing 
     32   USE wrk_nemo        ! Memory allocation 
    2833 
    2934   IMPLICIT NONE