New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5758 for branches/2015/dev_r5721_CNRS9_NOC3_LDF – NEMO

Ignore:
Timestamp:
2015-09-24T08:31:40+02:00 (9 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 
    3035   PRIVATE 
    3136 
    32    PUBLIC   tra_ldf_lap   ! routine called by step.F90 
     37   PUBLIC   tra_ldf_lap   ! routine called by traldf.F90 
    3338 
    3439   !! * Substitutions 
    3540#  include "domzgr_substitute.h90" 
    36 #  include "ldftra_substitute.h90" 
    3741#  include "vectopt_loop_substitute.h90" 
    3842   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     43   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4044   !! $Id$ 
    4145   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4347CONTAINS 
    4448 
    45    SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu , pgv ,    & 
    46       &                                        pgui, pgvi,    & 
    47       &                                ptb, pta, kjpt )  
     49   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
     50      &                                                    pgui, pgvi,   & 
     51      &                                        ptb , pta , kjpt, kpass )  
    4852      !!---------------------------------------------------------------------- 
    4953      !!                  ***  ROUTINE tra_ldf_lap  *** 
    … …  
    5559      !!      fields (forward time scheme). The horizontal diffusive trends of  
    5660      !!      the tracer is given by: 
    57       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ] 
    58       !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] } 
     61      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
     62      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
    5963      !!      Add this trend to the general tracer trend pta : 
    6064      !!          pta = pta + difft 
    … …  
    6367      !!                harmonic mixing trend. 
    6468      !!---------------------------------------------------------------------- 
    65       USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace 
    66       ! 
    6769      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    68       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     70      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    6971      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    7072      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     73      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     74      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    7175      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    72       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels 
     76      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    7377      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    7478      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    7579      ! 
    76       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    77       INTEGER  ::   iku, ikv, ierr       ! local integers 
    78       REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars 
     80      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     81      REAL(wp) ::   zsign            ! local scalars 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev 
    7983      !!---------------------------------------------------------------------- 
    8084      ! 
    81       IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 
     85      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap') 
    8286      ! 
    83       IF( kt == kit000 )  THEN 
    84          IF(lwp) WRITE(numout,*) 
    85          IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    86          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     87      IF( kt == nit000 .AND. lwp )  THEN 
     88         WRITE(numout,*) 
     89         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 
     90         WRITE(numout,*) '~~~~~~~~~~~ ' 
    8791      ENDIF 
    88  
    89       !                                                          ! =========== ! 
    90       DO jn = 1, kjpt                                            ! tracer loop ! 
    91          !                                                       ! =========== !     
    92          DO jk = 1, jpkm1                                            ! slab loop 
    93             !                                            
    94             ! 1. First derivative (gradient) 
    95             ! ------------------- 
     92      ! 
     93      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
     94      ! 
     95      !                                !==  Initialization of metric arrays used for all tracers  ==! 
     96      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
     97      ELSE                    ;   zsign = -1._wp 
     98      ENDIF 
     99      DO jk = 1, jpkm1 
     100         DO jj = 1, jpjm1 
     101            DO ji = 1, fs_jpim1   ! vector opt. 
     102               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked! 
     103               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk) 
     104            END DO 
     105         END DO 
     106      END DO 
     107      ! 
     108      !                             ! =========== ! 
     109      DO jn = 1, kjpt               ! tracer loop ! 
     110         !                          ! =========== !     
     111         !                                
     112         DO jk = 1, jpkm1              !== First derivative (gradient)  ==! 
    96113            DO jj = 1, jpjm1 
    97                DO ji = 1, fs_jpim1   ! vector opt. 
    98                   zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    99                   zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    100                   ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    101                   ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     114               DO ji = 1, fs_jpim1 
     115                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
     116                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
    102117               END DO 
    103118            END DO 
    104             IF( ln_zps ) THEN      ! set gradient at partial step level for the last ocean cell 
     119         END DO   
     120         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level 
     121            DO jj = 1, jpjm1                    ! bottom 
     122               DO ji = 1, fs_jpim1 
     123                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 
     124                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 
     125               END DO 
     126            END DO   
     127            IF( ln_isfcav ) THEN                ! top in ocean cavities only 
    105128               DO jj = 1, jpjm1 
    106129                  DO ji = 1, fs_jpim1   ! vector opt. 
    107                      ! last level 
    108                      iku = mbku(ji,jj) 
    109                      ikv = mbkv(ji,jj) 
    110                      IF( iku == jk ) THEN 
    111                         zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
    112                         ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 
    113                      ENDIF 
    114                      IF( ikv == jk ) THEN 
    115                         zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
    116                         ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 
    117                      ENDIF 
     130                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)  
     131                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)  
    118132                  END DO 
    119133               END DO 
    120134            ENDIF 
    121             ! (ISH) 
    122             IF( ln_zps .AND. ln_isfcav ) THEN      ! set gradient at partial step level for the first ocean cell 
    123                                                    ! into a cavity 
    124                DO jj = 1, jpjm1 
    125                   DO ji = 1, fs_jpim1   ! vector opt. 
    126                      ! ice shelf level level MAX(2,jk) => only where ice shelf 
    127                      iku = miku(ji,jj)  
    128                      ikv = mikv(ji,jj)  
    129                      IF( iku == MAX(2,jk) ) THEN  
    130                         zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku)  
    131                         ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn)  
    132                      ENDIF  
    133                      IF( ikv == MAX(2,jk) ) THEN  
    134                         zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv)  
    135                         ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn)  
    136                      END IF  
    137                   END DO 
    138                END DO 
    139             ENDIF 
    140           
    141           
    142             ! 2. Second derivative (divergence) added to the general tracer trends 
    143             ! --------------------------------------------------------------------- 
     135         ENDIF 
     136         ! 
     137         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==! 
    144138            DO jj = 2, jpjm1 
    145                DO ji = fs_2, fs_jpim1   ! vector opt. 
    146                   zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    147                   ! horizontal diffusive trends added to the general tracer trends 
    148                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    149                      &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
     139               DO ji = fs_2, fs_jpim1 
     140                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
     141                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
     142                     &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    150143               END DO 
    151144            END DO 
    152             ! 
    153          END DO                                             !  End of slab   
     145         END DO   
    154146         ! 
    155          ! "Poleward" diffusive heat or salt transports 
    156          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    157             IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    158             IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     147         !                             !== "Poleward" diffusive heat or salt transports  ==! 
     148         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     149             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==! 
     150            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     151               IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 
     152               IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 
     153            ENDIF 
    159154         ENDIF 
    160          !                                                  ! ================== 
    161       END DO                                                ! end of tracer loop 
    162       !                                                     ! ================== 
    163       IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 
     155         !                          ! ================== 
     156      END DO                        ! end of tracer loop 
     157      !                             ! ================== 
     158      ! 
     159      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
     160      ! 
     161      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap') 
    164162      ! 
    165163   END SUBROUTINE tra_ldf_lap 
    166  
     164    
    167165   !!============================================================================== 
    168166END MODULE traldf_lap 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r5722 r5758  
    1 MODULE traldf_iso_grif 
     1MODULE traldf_triad 
    22   !!====================================================================== 
    3    !!                   ***  MODULE  traldf_iso_grif  *** 
     3   !!                   ***  MODULE  traldf_triad  *** 
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec) 
    7    !!                !          Griffies operator version adapted from traldf_iso.F90 
     6   !! History :  3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  Griffies operator (original code) 
     7   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
    88   !!---------------------------------------------------------------------- 
    9 #if   defined key_ldfslp   ||   defined key_esopa 
     9 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_ldfslp'               slope of the lateral diffusive direction 
    12    !!---------------------------------------------------------------------- 
    13    !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component 
    14    !!                       of the Griffies iso-neutral laplacian operator 
     11   !!   tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator 
    1512   !!---------------------------------------------------------------------- 
    1613   USE oce             ! ocean dynamics and active tracers 
    … …  
    1916   USE trc_oce         ! share passive tracers/Ocean variables 
    2017   USE zdf_oce         ! ocean vertical physics 
    21    USE ldftra_oce      ! ocean active tracers: lateral physics 
    22    USE ldfslp          ! iso-neutral slopes 
     18   USE ldftra          ! lateral physics: eddy diffusivity 
     19   USE ldfslp          ! lateral physics: iso-neutral slopes 
     20   USE traldf_iso      ! lateral diffusion (Madec operator)         (tra_ldf_iso routine) 
    2321   USE diaptr          ! poleward transport diagnostics 
     22   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
     23   ! 
    2424   USE in_out_manager  ! I/O manager 
    2525   USE iom             ! I/O library 
    … …  
    2929   USE timing          ! Timing 
    3030 
    31  
    3231   IMPLICIT NONE 
    3332   PRIVATE 
    3433 
    35    PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90 
    36  
    37    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only) 
    38    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2 
    39    REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d               !: vertical tracer gradient at 2 levels 
     34   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90 
     35 
     36   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels 
    4037 
    4138   !! * Substitutions 
    4239#  include "domzgr_substitute.h90" 
    43 #  include "ldftra_substitute.h90" 
    4440#  include "vectopt_loop_substitute.h90" 
    45 #  include "ldfeiv_substitute.h90" 
    4641   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4843   !! $Id$ 
    4944   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5146CONTAINS 
    5247 
    53   SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              & 
    54        &                                   ptb, pta, kjpt, pahtb0 ) 
     48  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
     49      &                                                     pgui, pgvi,   & 
     50      &                                         ptb , ptbb, pta , kjpt, kpass ) 
    5551      !!---------------------------------------------------------------------- 
    56       !!                  ***  ROUTINE tra_ldf_iso_grif  *** 
     52      !!                  ***  ROUTINE tra_ldf_triad  *** 
    5753      !! 
    5854      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
    … …  
    6662      !!      nal or geopotential slopes computed in routine ldfslp. 
    6763      !! 
    68       !!      1st part :  masked horizontal derivative of T  ( di[ t ] ) 
    69       !!      ========    with partial cell update if ln_zps=T. 
     64      !!      see documentation for the desciption 
    7065      !! 
    71       !!      2nd part :  horizontal fluxes of the lateral mixing operator 
    72       !!      ======== 
    73       !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 
    74       !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ] 
    75       !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ] 
    76       !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ] 
    77       !!      take the horizontal divergence of the fluxes: 
    78       !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
    79       !!      Add this trend to the general trend (ta,sa): 
    80       !!         ta = ta + difft 
    81       !! 
    82       !!      3rd part: vertical trends of the lateral mixing operator 
    83       !!      ========  (excluding the vertical flux proportional to dk[t] ) 
    84       !!      vertical fluxes associated with the rotated lateral mixing: 
    85       !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ] 
    86       !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  } 
    87       !!      take the horizontal divergence of the fluxes: 
    88       !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
    89       !!      Add this trend to the general trend (ta,sa): 
    90       !!         pta = pta + difft 
    91       !! 
    92       !! ** Action :   Update pta arrays with the before rotated diffusion 
     66      !! ** Action :   pta   updated with the before rotated diffusion 
     67      !!               ah_wslp2 .... 
     68      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp) 
    9369      !!---------------------------------------------------------------------- 
    94       USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace 
    95       ! 
    9670      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    9771      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    9872      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    9973      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     74      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    10076      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     77      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
    10280      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    103       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    104       ! 
    105       INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices 
    106       INTEGER  ::  ip,jp,kp        ! dummy loop indices 
    107       INTEGER  ::  ierr            ! temporary integer 
    108       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    109       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    110       REAL(wp) ::  zcoef0, zbtr                  !   -      - 
     81      ! 
     82      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     83      INTEGER  ::  ip,jp,kp         ! dummy loop indices 
     84      INTEGER  ::  ierr            ! local integer 
     85      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars 
     86      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      - 
     87      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      - 
    11188      ! 
    11289      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    113       REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 
     90      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    11491      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115       REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw  
    117       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace 
     92#if defined key_diaar5 
     93      REAL(wp) ::   zztmp              ! local scalar 
     94#endif 
     95      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace 
     96      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    11897      !!---------------------------------------------------------------------- 
    11998      ! 
    120       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_grif') 
    121       ! 
    122       CALL wrk_alloc( jpi, jpj,      z2d )  
    123       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  )  
    124       ! 
    125  
    126       IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) )  THEN 
     99      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad') 
     100      ! 
     101      CALL wrk_alloc( jpi,jpj,       z2d )  
     102      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
     103      ! 
     104      IF( .NOT.ALLOCATED(zdkt3d) )  THEN 
     105         ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr ) 
     106         IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     107         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays') 
     108      ENDIF 
     109     ! 
     110      IF( kpass == 1 .AND. kt == kit000 )  THEN 
    127111         IF(lwp) WRITE(numout,*) 
    128          IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype 
    129          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    130          ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr ) 
    131          IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    132          IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 
    133          IF( ln_traldf_gdia ) THEN 
    134             IF (.NOT. ALLOCATED(psix_eiv))THEN 
    135                 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    136                 IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    137                 IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 
    138             ENDIF 
     112         IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 
     113         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
     114      ENDIF 
     115      ! 
     116      !                                               ! set time step size (Euler/Leapfrog) 
     117      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdttra(1)      ! at nit000   (Euler) 
     118      ELSE                                        ;   z2dt = 2.* rdttra(1)      !             (Leapfrog) 
     119      ENDIF 
     120      z1_2dt = 1._wp / z2dt 
     121      ! 
     122      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
     123      ELSE                    ;   zsign = -1._wp 
     124      ENDIF 
     125                   
     126      !!---------------------------------------------------------------------- 
     127      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw 
     128      !!---------------------------------------------------------------------- 
     129      ! 
     130      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
     131         ! 
     132         akz     (:,:,:) = 0._wp       
     133         ah_wslp2(:,:,:) = 0._wp 
     134         IF( ln_ldfeiv_dia ) THEN 
     135            zpsi_uw(:,:,:) = 0._wp 
     136            zpsi_vw(:,:,:) = 0._wp 
    139137         ENDIF 
    140       ENDIF 
    141  
    142       !!---------------------------------------------------------------------- 
    143       !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv 
    144       !!---------------------------------------------------------------------- 
    145  
    146       !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads 
    147  
    148       ah_wslp2(:,:,:) = 0._wp 
    149       IF( ln_traldf_gdia ) THEN 
    150          psix_eiv(:,:,:) = 0._wp 
    151          psiy_eiv(:,:,:) = 0._wp 
    152       ENDIF 
    153  
    154       DO ip = 0, 1 
    155          DO kp = 0, 1 
    156             DO jk = 1, jpkm1 
    157                DO jj = 1, jpjm1 
    158                   DO ji = 1, fs_jpim1 
    159                      ze1ur = 1._wp / e1u(ji,jj) 
    160                      ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    161                      zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    162                      zah   = fsahtu(ji,jj,jk)                                  ! fsaht(ji+ip,jj,jk) 
    163                      zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    164                      ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    165                      ! (do this by *adding* gradient of depth) 
    166                      zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 
    167                      zslope2 = zslope2 *zslope2 
    168                      ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    & 
    169                         &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2 
    170                      IF( ln_traldf_gdia ) THEN 
    171                         zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew           ! fsaeit(ji+ip,jj,jk)*zslope_skew 
    172                         psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 
    173                      ENDIF 
     138         ! 
     139         DO ip = 0, 1                            ! i-k triads 
     140            DO kp = 0, 1 
     141               DO jk = 1, jpkm1 
     142                  DO jj = 1, jpjm1 
     143                     DO ji = 1, fs_jpim1 
     144                        ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     145                        zbu   = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     146                        zah   = 0.25_wp * pahu(ji,jj,jk) 
     147                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
     148                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
     149                        zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     150                        zslope2 = zslope2 *zslope2 
     151                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 
     152                        akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       & 
     153                           &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     154                        ! 
     155                       IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   & 
     156                           &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew 
     157                     END DO 
    174158                  END DO 
    175159               END DO 
    176160            END DO 
    177161         END DO 
    178       END DO 
    179       ! 
    180       DO jp = 0, 1 
    181          DO kp = 0, 1 
    182             DO jk = 1, jpkm1 
    183                DO jj = 1, jpjm1 
    184                   DO ji=1,fs_jpim1 
    185                      ze2vr = 1._wp / e2v(ji,jj) 
    186                      ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 
    187                      zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    188                      zah   = fsahtv(ji,jj,jk)                                  ! fsaht(ji,jj+jp,jk) 
    189                      zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    190                      ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    191                      !    (do this by *adding* gradient of depth) 
    192                      zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 
    193                      zslope2 = zslope2 * zslope2 
    194                      ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   & 
    195                         &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2 
    196                      IF( ln_traldf_gdia ) THEN 
    197                         zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew           ! fsaeit(ji,jj+jp,jk)*zslope_skew 
    198                         psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 
    199                      ENDIF 
     162         ! 
     163         DO jp = 0, 1                            ! j-k triads  
     164            DO kp = 0, 1 
     165               DO jk = 1, jpkm1 
     166                  DO jj = 1, jpjm1 
     167                     DO ji = 1, fs_jpim1 
     168                        ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 
     169                        zbv   = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     170                        zah   = 0.25_wp * pahv(ji,jj,jk) 
     171                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
     172                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
     173                        !    (do this by *adding* gradient of depth) 
     174                        zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     175                        zslope2 = zslope2 * zslope2 
     176                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 
     177                        akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     & 
     178                           &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     179                        ! 
     180                        IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   & 
     181                           &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew 
     182                     END DO 
    200183                  END DO 
    201184               END DO 
    202185            END DO 
    203186         END DO 
    204       END DO 
    205       ! 
    206       IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN 
    207          ! 
    208          IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
    209             CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
    210             DO jk=1,jpkm1 
    211                zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    212             END DO 
    213             zw3d(:,:,jpk) = 0._wp 
    214             CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
    215  
    216             DO jk=1,jpk-1 
    217                zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    218             END DO 
    219             zw3d(:,:,jpk) = 0._wp 
    220             CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
    221  
    222             DO jk=1,jpk-1 
    223                DO jj = 2, jpjm1 
    224                   DO ji = fs_2, fs_jpim1  ! vector opt. 
    225                      zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
    226                           &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    227                   END DO 
    228                END DO 
    229             END DO 
    230             zw3d(:,:,jpk) = 0._wp 
    231             CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
    232             CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     187         ! 
     188         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
     189            ! 
     190            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
     191               DO jk = 2, jpkm1 
     192                  DO jj = 1, jpjm1 
     193                     DO ji = 1, fs_jpim1 
     194                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
     195                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  ) 
     196                     END DO 
     197                  END DO 
     198               END DO 
     199            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
     200               DO jk = 2, jpkm1 
     201                  DO jj = 1, jpjm1 
     202                     DO ji = 1, fs_jpim1 
     203                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     204                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     205                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     206                     END DO 
     207                  END DO 
     208               END DO 
     209           ENDIF 
     210           ! 
     211         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
     212            akz(:,:,:) = ah_wslp2(:,:,:)       
    233213         ENDIF 
    234214         ! 
    235       ENDIF 
    236       !                                                          ! =========== 
    237       DO jn = 1, kjpt                                            ! tracer loop 
    238          !                                                       ! =========== 
     215         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
     216         ! 
     217      ENDIF                                  !==  end 1st pass only  ==! 
     218      ! 
     219      !                                                           ! =========== 
     220      DO jn = 1, kjpt                                             ! tracer loop 
     221         !                                                        ! =========== 
    239222         ! Zero fluxes for each tracer 
     223!!gm  this should probably be done outside the jn loop 
    240224         ztfw(:,:,:) = 0._wp 
    241225         zftu(:,:,:) = 0._wp 
    242226         zftv(:,:,:) = 0._wp 
    243227         ! 
    244          DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
     228         DO jk = 1, jpkm1        !==  before lateral T & S gradients at T-level jk  ==! 
    245229            DO jj = 1, jpjm1 
    246230               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    250234            END DO 
    251235         END DO 
    252          IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level 
    253             DO jj = 1, jpjm1 
    254                DO ji = 1, jpim1 
     236         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
     237            DO jj = 1, jpjm1                       ! bottom level 
     238               DO ji = 1, fs_jpim1   ! vector opt. 
    255239                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    256240                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    257241               END DO 
    258242            END DO 
     243            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
     244               DO jj = 1, jpjm1 
     245                  DO ji = 1, fs_jpim1   ! vector opt. 
     246                     IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn)  
     247                     IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn)  
     248                  END DO 
     249               END DO 
     250            ENDIF 
    259251         ENDIF 
    260252 
    … …  
    272264            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
    273265            ENDIF 
    274  
    275  
    276             IF (ln_botmix_grif) THEN 
     266            ! 
     267            zaei_slp = 0._wp 
     268            ! 
     269            IF( ln_botmix_triad ) THEN 
    277270               DO ip = 0, 1              !==  Horizontal & vertical fluxes 
    278271                  DO kp = 0, 1 
    279272                     DO jj = 1, jpjm1 
    280273                        DO ji = 1, fs_jpim1 
    281                            ze1ur = 1._wp / e1u(ji,jj) 
     274                           ze1ur = r1_e1u(ji,jj) 
     275                           zdxt  = zdit(ji,jj,jk) * ze1ur 
     276                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     277                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
     278                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
     279                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp) 
     280 
     281                           zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     282                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
     283                           zah = pahu(ji,jj,jk) 
     284                           zah_slp  = zah * zslope_iso 
     285                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew 
     286                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
     287                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr 
     288                        END DO 
     289                     END DO 
     290                  END DO 
     291               END DO 
     292 
     293               DO jp = 0, 1 
     294                  DO kp = 0, 1 
     295                     DO jj = 1, jpjm1 
     296                        DO ji = 1, fs_jpim1 
     297                           ze2vr = r1_e2v(ji,jj) 
     298                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
     299                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
     300                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
     301                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
     302                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
     303                           zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     304                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked... 
     305                           zah = pahv(ji,jj,jk) 
     306                           zah_slp = zah * zslope_iso 
     307                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew 
     308                           zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
     309                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr 
     310                        END DO 
     311                     END DO 
     312                  END DO 
     313               END DO 
     314 
     315            ELSE 
     316 
     317               DO ip = 0, 1               !==  Horizontal & vertical fluxes 
     318                  DO kp = 0, 1 
     319                     DO jj = 1, jpjm1 
     320                        DO ji = 1, fs_jpim1 
     321                           ze1ur = r1_e1u(ji,jj) 
    282322                           zdxt  = zdit(ji,jj,jk) * ze1ur 
    283323                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    … …  
    286326                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    287327 
    288                            zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    289                            ! ln_botmix_grif is .T. don't mask zah for bottom half cells 
    290                            zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ???? 
     328                           zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     329                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
     330                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
    291331                           zah_slp  = zah * zslope_iso 
    292                            zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew 
    293                            zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
     332                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew 
     333                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    294334                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
    295335                        END DO 
    … …  
    302342                     DO jj = 1, jpjm1 
    303343                        DO ji = 1, fs_jpim1 
    304                            ze2vr = 1._wp / e2v(ji,jj) 
     344                           ze2vr = r1_e2v(ji,jj) 
    305345                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
    306346                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
    … …  
    308348                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    309349                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    310                            zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    311                            ! ln_botmix_grif is .T. don't mask zah for bottom half cells 
    312                            zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)  ! fsaht(ji,jj+jp,jk) 
     350                           zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 
     351                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
     352                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ???? 
    313353                           zah_slp = zah * zslope_iso 
    314                            zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
     354                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
    315355                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    316356                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
    … …  
    319359                  END DO 
    320360               END DO 
    321             ELSE 
    322                DO ip = 0, 1              !==  Horizontal & vertical fluxes 
    323                   DO kp = 0, 1 
    324                      DO jj = 1, jpjm1 
    325                         DO ji = 1, fs_jpim1 
    326                            ze1ur = 1._wp / e1u(ji,jj) 
    327                            zdxt  = zdit(ji,jj,jk) * ze1ur 
    328                            ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    329                            zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    330                            zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    331                            zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    332  
    333                            zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    334                            ! ln_botmix_grif is .F. mask zah for bottom half cells 
    335                            zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! fsaht(ji+ip,jj,jk)   ===>>  ???? 
    336                            zah_slp  = zah * zslope_iso 
    337                            zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew 
    338                            zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    339                            ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
    340                         END DO 
    341                      END DO 
    342                   END DO 
    343                END DO 
    344  
    345                DO jp = 0, 1 
    346                   DO kp = 0, 1 
    347                      DO jj = 1, jpjm1 
    348                         DO ji = 1, fs_jpim1 
    349                            ze2vr = 1._wp / e2v(ji,jj) 
    350                            zdyt  = zdjt(ji,jj,jk) * ze2vr 
    351                            ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
    352                            zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    353                            zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    354                            zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    355                            zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    356                            ! ln_botmix_grif is .F. mask zah for bottom half cells 
    357                            zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! fsaht(ji,jj+jp,jk) 
    358                            zah_slp = zah * zslope_iso 
    359                            zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
    360                            zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    361                            ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
    362                         END DO 
    363                      END DO 
    364                   END DO 
    365                END DO 
    366             END IF 
    367             !                          !==  divergence and add to the general trend  ==! 
     361            ENDIF 
     362            !                             !==  horizontal divergence and add to the general trend  ==! 
    368363            DO jj = 2 , jpjm1 
    369364               DO ji = fs_2, fs_jpim1  ! vector opt. 
    370                   zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    371                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   & 
    372                      &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   ) 
     365                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
     366                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   & 
     367                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
    373368               END DO 
    374369            END DO 
    … …  
    376371         END DO 
    377372         ! 
    378          DO jk = 1, jpkm1              !== Divergence of vertical fluxes added to the general tracer trend 
     373         !                                !==  add the vertical 33 flux  ==! 
     374         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
     375            DO jk = 2, jpkm1        
     376               DO jj = 1, jpjm1 
     377                  DO ji = fs_2, fs_jpim1 
     378                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   & 
     379                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
     380                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     381                  END DO 
     382               END DO 
     383            END DO 
     384         ELSE                                   ! bilaplacian  
     385            SELECT CASE( kpass ) 
     386            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
     387               DO jk = 2, jpkm1  
     388                  DO jj = 1, jpjm1 
     389                     DO ji = fs_2, fs_jpim1 
     390                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)             & 
     391                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     392                     END DO 
     393                  END DO 
     394               END DO  
     395            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     396               DO jk = 2, jpkm1  
     397                  DO jj = 1, jpjm1 
     398                     DO ji = fs_2, fs_jpim1 
     399                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     400                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
     401                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     402                     END DO 
     403                  END DO 
     404               END DO 
     405            END SELECT  
     406         ENDIF 
     407         ! 
     408         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    379409            DO jj = 2, jpjm1 
    380410               DO ji = fs_2, fs_jpim1  ! vector opt. 
    381                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
    382                      &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     411                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
     412                     &                                        / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    383413               END DO 
    384414            END DO 
    385415         END DO 
    386416         ! 
    387          !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    388          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    389             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
    390             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    391          ENDIF 
    392  
    393          IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
    394            ! 
    395            IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    396                z2d(:,:) = 0._wp  
    397                DO jk = 1, jpkm1 
    398                   DO jj = 2, jpjm1 
    399                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    400                         z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
    401                      END DO 
    402                   END DO 
    403                END DO 
    404                z2d(:,:) = rau0_rcp * z2d(:,:)  
    405                CALL lbc_lnk( z2d, 'U', -1. ) 
    406                CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     417         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     418             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==! 
     419            ! 
     420            !                          ! "Poleward" diffusive heat or salt transports (T-S case only) 
     421            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     422               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
     423               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
     424            ENDIF 
     425            ! 
     426            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     427              ! 
     428              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     429                  z2d(:,:) = zftu(ji,jj,1)  
     430                  DO jk = 2, jpkm1 
     431                     DO jj = 2, jpjm1 
     432                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     433                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     434                        END DO 
     435                     END DO 
     436                  END DO 
     437                  z2d(:,:) = rau0_rcp * z2d(:,:)  
     438                  CALL lbc_lnk( z2d, 'U', -1. ) 
     439                  CALL iom_put( "udiff_heattr", z2d )                  ! heat i-transport 
     440                  ! 
     441                  z2d(:,:) = zftv(ji,jj,1)  
     442                  DO jk = 2, jpkm1 
     443                     DO jj = 2, jpjm1 
     444                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     445                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     446                        END DO 
     447                     END DO 
     448                  END DO 
     449                  z2d(:,:) = rau0_rcp * z2d(:,:)      
     450                  CALL lbc_lnk( z2d, 'V', -1. ) 
     451                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat j-transport 
     452               ENDIF 
    407453               ! 
    408                z2d(:,:) = 0._wp  
    409                DO jk = 1, jpkm1 
    410                   DO jj = 2, jpjm1 
    411                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    412                         z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
    413                      END DO 
    414                   END DO 
    415                END DO 
    416                z2d(:,:) = rau0_rcp * z2d(:,:)      
    417                CALL lbc_lnk( z2d, 'V', -1. ) 
    418                CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    419             END IF 
    420             ! 
    421          ENDIF 
    422          ! 
    423       END DO 
    424       ! 
    425       CALL wrk_dealloc( jpi, jpj,      z2d )  
    426       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  )  
    427       ! 
    428       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_grif') 
    429       ! 
    430   END SUBROUTINE tra_ldf_iso_grif 
    431  
    432 #else 
    433    !!---------------------------------------------------------------------- 
    434    !!   default option :   Dummy code   NO rotation of the diffusive tensor 
    435    !!---------------------------------------------------------------------- 
    436    REAL, PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only) 
    437 CONTAINS 
    438    SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              & 
    439        &                                   ptb, pta, kjpt, pahtb0 ) 
    440       CHARACTER(len=3) ::   cdtype 
    441       INTEGER          ::   kit000     ! first time step index 
    442       REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels 
    443       REAL, DIMENSION(:,:,:,:) ::   ptb, pta 
    444       WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, cdtype,    & 
    445          &                  pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 
    446    END SUBROUTINE tra_ldf_iso_grif 
    447 #endif 
     454            ENDIF 
     455            ! 
     456         ENDIF                                                    !== end pass selection  ==! 
     457         ! 
     458         !                                                        ! =============== 
     459      END DO                                                      ! end tracer loop 
     460      !                                                           ! =============== 
     461      ! 
     462      CALL wrk_dealloc( jpi,jpj,       z2d )  
     463      CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
     464      ! 
     465      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad') 
     466      ! 
     467   END SUBROUTINE tra_ldf_triad 
    448468 
    449469   !!============================================================================== 
    450 END MODULE traldf_iso_grif 
     470END MODULE traldf_triad 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5656 r5758  
    3737   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    3838   USE phycst          ! physical constant 
    39    USE ldftra_oce      ! lateral physics on tracers 
     39   USE ldftra          ! lateral physics on tracers 
     40   USE ldfslp 
    4041   USE bdy_oce         ! BDY open boundary condition variables 
    4142   USE bdytra          ! open boundary condition (bdy_tra routine) 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r5385 r5758  
    1919   USE sbc_oce         ! surface boundary condition: ocean 
    2020   USE dynspg_oce 
     21   ! 
     22   USE ldftra          ! lateral diffusion: eddy diffusivity 
     23   USE ldfslp          ! lateral diffusion: iso-neutral slope  
    2124   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2225   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    23    USE ldftra_oce      ! ocean active tracers: lateral physics 
     26   ! 
    2427   USE trd_oce         ! trends: ocean variables 
    2528   USE trdtra          ! trends manager: tracers  
    … …  
    4548#  include "vectopt_loop_substitute.h90" 
    4649   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     50   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4851   !! $Id$ 
    4952   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8891         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    8992      END SELECT 
     93!!gm WHY here !   and I don't like that ! 
    9094      ! DRAKKAR SSS control { 
    9195      ! JMM avoid negative salinities near river outlet ! Ugly fix 
    9296      ! JMM : restore negative salinities to small salinities: 
    9397      WHERE ( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp 
     98!!gm 
    9499 
    95100      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    … …  
    98103            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
    99104         END DO 
     105!!gm this should be moved in trdtra.F90 and done on all trends 
    100106         CALL lbc_lnk( ztrdt, 'T', 1. ) 
    101107         CALL lbc_lnk( ztrds, 'T', 1. ) 
     108!!gm 
    102109         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
    103110         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 
    … …  
    123130      !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T) 
    124131      !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F) 
    125       !!      NB: rotation of lateral mixing operator or TKE or KPP scheme, 
    126       !!      the implicit scheme is required. 
     132      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes, 
     133      !!          an implicit scheme is required. 
    127134      !!---------------------------------------------------------------------- 
    128135      USE zdftke 
    129136      USE zdfgls 
    130       USE zdfkpp 
    131137      !!---------------------------------------------------------------------- 
    132138 
    … …  
    137143 
    138144      ! Force implicit schemes 
    139       IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics 
    140       IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics 
    141       IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
     145      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics 
     146      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics 
     147      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate 
    142148      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   & 
    143             &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 
     149            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 
    144150 
    145151      ! Test: esopa 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r5120 r5758  
    1919   
    2020   !!---------------------------------------------------------------------- 
    21    !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical   
    22    !!                 part of the mixing tensor. 
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and tracers variables 
    25    USE dom_oce         ! ocean space and time domain variables  
    26    USE zdf_oce         ! ocean vertical physics variables 
    27    USE trc_oce         ! share passive tracers/ocean variables 
    28    USE domvvl          ! variable volume 
    29    USE ldftra_oce      ! ocean active tracers: lateral physics 
    30    USE ldftra          ! lateral mixing type 
    31    USE ldfslp          ! lateral physics: slope of diffusion 
    32    USE zdfddm          ! ocean vertical physics: double diffusion 
    33    USE traldf_iso_grif ! active tracers: Griffies operator 
    34    USE in_out_manager  ! I/O manager 
    35    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    36    USE lib_mpp         ! MPP library 
    37    USE wrk_nemo        ! Memory Allocation 
    38    USE timing          ! Timing 
     21   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical part of the mixing tensor. 
     22   !!---------------------------------------------------------------------- 
     23   USE oce              ! ocean dynamics and tracers variables 
     24   USE dom_oce          ! ocean space and time domain variables  
     25   USE zdf_oce          ! ocean vertical physics variables 
     26   USE trc_oce          ! share passive tracers/ocean variables 
     27   USE domvvl           ! variable volume 
     28   USE ldftra           ! lateral mixing type 
     29   USE ldfslp           ! lateral physics: slope of diffusion 
     30   USE zdfddm           ! ocean vertical physics: double diffusion 
     31   USE traldf_iso_triad ! active tracers: Method of Stabilizing Correction 
     32   ! 
     33   USE in_out_manager   ! I/O manager 
     34   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
     35   USE lib_mpp          ! MPP library 
     36   USE wrk_nemo         ! Memory Allocation 
     37   USE timing           ! Timing 
    3938 
    4039   IMPLICIT NONE 
    … …  
    4746   !! * Substitutions 
    4847#  include "domzgr_substitute.h90" 
    49 #  include "ldftra_substitute.h90" 
    5048#  include "zdfddm_substitute.h90" 
    5149#  include "vectopt_loop_substitute.h90" 
    5250   !!---------------------------------------------------------------------- 
    53    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     51   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    5452   !! $Id$ 
    5553   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    120118            ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 
    121119            ENDIF 
    122             DO jj=1, jpj 
    123                DO ji=1, jpi 
    124                   zwt(ji,jj,1) = 0._wp 
    125                END DO 
    126             END DO 
    127 ! 
    128 #if defined key_ldfslp 
    129             ! isoneutral diffusion: add the contribution  
    130             IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff 
    131                DO jk = 2, jpkm1 
    132                   DO jj = 2, jpjm1 
    133                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    134                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)        
     120            zwt(:,:,1) = 0._wp 
     121            ! 
     122            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
     123               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
     124                  DO jk = 2, jpkm1 
     125                     DO jj = 2, jpjm1 
     126                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     127                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
     128                        END DO 
    135129                     END DO 
    136130                  END DO 
    137                END DO 
    138             ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff 
    139                DO jk = 2, jpkm1 
    140                   DO jj = 2, jpjm1 
    141                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       & 
    143                            &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    144                            &                             + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     131               ELSE                          ! standard or triad iso-neutral operator 
     132                  DO jk = 2, jpkm1 
     133                     DO jj = 2, jpjm1 
     134                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     135                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
     136                        END DO 
    145137                     END DO 
    146138                  END DO 
    147                END DO 
     139               ENDIF 
    148140            ENDIF 
    149 #endif 
     141            ! 
    150142            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    151143            DO jk = 1, jpkm1 
    … …  
    202194               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1) 
    203195               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 
    204                pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn)                     & 
    205                   &                      + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 
     196               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 
    206197            END DO 
    207198         END DO 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r5120 r5758  
    9393      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    9494      ! 
    95       INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    96       INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points 
    97       REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    98       REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
    99       REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
     95      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices 
     96      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points 
     97      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars 
     98      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     99      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             !  
    100100      !!---------------------------------------------------------------------- 
    101101      ! 
    102       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
    103       ! 
    104       pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 
    105       zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 
    106       zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ; 
     102      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
     103      ! 
     104      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
     105      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
    107106      ! 
    108107      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    149148         ! 
    150149      END DO 
    151  
    152       ! horizontal derivative of density anomalies (rd) 
    153       IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    154          pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
     150      !                 
     151      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
     152         pgru(:,:) = 0._wp 
     153         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    155154         DO jj = 1, jpjm1 
    156155            DO ji = 1, jpim1 
    … …  
    167166            END DO 
    168167         END DO 
    169  
    170          ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    171          ! step and store it in  zri, zrj for each  case 
    172          CALL eos( zti, zhi, zri )   
    173          CALL eos( ztj, zhj, zrj ) 
    174  
    175          ! Gradient of density at the last level  
    176          DO jj = 1, jpjm1 
     168         ! 
     169         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
     170         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
     171         ! 
     172         DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    177173            DO ji = 1, jpim1 
    178174               iku = mbku(ji,jj) 
    … …  
    192188      END IF 
    193189      ! 
    194       IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 
     190      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde') 
    195191      ! 
    196192   END SUBROUTINE zps_hde 
    197    ! 
    198    SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv,   & 
    199       &                          prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv,  & 
    200       &                   pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 
     193 
     194 
     195   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu , pgtv , pgtui, pgtvi,                                   & 
     196      &                              prd, pgru , pgrv , pmru , pmrv , pgzu , pgzv , pge3ru , pge3rv ,   & 
     197      &                                   pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 
    201198      !!---------------------------------------------------------------------- 
    202199      !!                     ***  ROUTINE zps_hde  *** 
    … …  
    245242      !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points  
    246243      !!---------------------------------------------------------------------- 
    247       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    248       INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    249       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    250       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
    251       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF) 
    252       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    253       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv      ! hor. grad of prd at u- & v-pts (bottom) 
    254       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmru, pmrv      ! hor. sum  of prd at u- & v-pts (bottom) 
    255       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu, pgzv      ! hor. grad of z   at u- & v-pts (bottom) 
    256       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru, pge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom) 
    257       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top) 
    258       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui, pmrvi      ! hor. sum  of prd at u- & v-pts (top) 
    259       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui, pgzvi      ! hor. grad of z   at u- & v-pts (top) 
    260       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui, pge3rvi  ! hor. grad of prd weighted by local e3w at u- & v-pts (top) 
     244      INTEGER                              , INTENT(in   )           ::  kt                ! ocean time-step index 
     245      INTEGER                              , INTENT(in   )           ::  kjpt              ! number of tracers 
     246      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta               ! 4D tracers fields 
     247      !                                                              !!  u-point ! v-point ! 
     248      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu    , pgtv    ! bottom GRADh( ptra )   
     249      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui   , pgtvi   ! top    GRADh( ptra ) 
     250      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd               ! 3D density anomaly fields 
     251      !                                                              !!  u-point ! v-point ! 
     252      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru    , pgrv    ! bottom GRADh( prd  ) 
     253      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmru    , pmrv    ! bottom SUM  ( prd  ) 
     254      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu    , pgzv    ! bottom GRADh( z    )  
     255      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru  , pge3rv  ! bottom GRADh( prd  ) weighted by e3w 
     256      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui   , pgrvi   ! top    GRADh( prd  )  
     257      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui   , pmrvi   ! top    SUM  ( prd  )  
     258      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui   , pgzvi   ! top    GRADh( z    )  
     259      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui , pge3rvi ! top    GRADh( prd  ) weighted by e3w 
    261260      ! 
    262261      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    … …  
    269268      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf') 
    270269      ! 
    271       pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 
    272       pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ; 
    273       zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 
    274       zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ; 
     270      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
     271      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp 
     272      zti  (:,:,:) = 0._wp   ;   ztj  (:,:,:) =0._wp 
     273      zhi  (:,:  ) = 0._wp   ;   zhj  (:,:  ) =0._wp 
    275274      ! 
    276275      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    322321      END DO 
    323322 
    324       ! horizontal derivative of density anomalies (rd) 
    325       IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    326          pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
    327          pgzu(:,:)=0.0_wp   ; pgzv(:,:)=0.0_wp ; 
    328          pmru(:,:)=0.0_wp   ; pmru(:,:)=0.0_wp ; 
    329          pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ; 
    330          DO jj = 1, jpjm1 
     323      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
     324         ! 
     325         pgru  (:,:)=0._wp   ;   pgrv  (:,:) = 0._wp 
     326         pgzu  (:,:)=0._wp   ;   pgzv  (:,:) = 0._wp  
     327         pmru  (:,:)=0._wp   ;   pmru  (:,:) = 0._wp  
     328         pge3ru(:,:)=0._wp   ;   pge3rv(:,:) = 0._wp  
     329         ! 
     330         DO jj = 1, jpjm1                 ! depth of the partial step level 
    331331            DO ji = 1, jpim1 
    332332               iku = mbku(ji,jj) 
    … …  
    334334               ze3wu  = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 
    335335               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 
    336  
     336               ! 
    337337               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu     ! i-direction: case 1 
    338338               ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) + ze3wu    ! -     -      case 2 
    … …  
    343343            END DO 
    344344         END DO 
    345           
    346          ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    347          ! step and store it in  zri, zrj for each  case 
    348          CALL eos( zti, zhi, zri )   
    349          CALL eos( ztj, zhj, zrj ) 
    350  
    351          ! Gradient of density at the last level  
    352          DO jj = 1, jpjm1 
     345         ! 
     346         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
     347         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
     348 
     349         DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    353350            DO ji = 1, jpim1 
    354351               iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    394391         ! 
    395392      END IF 
    396          ! (ISH)  compute grui and gruvi 
     393      ! 
     394      !     !==  (ISH)  compute grui and gruvi  ==! 
     395      ! 
    397396      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    398397         DO jj = 1, jpjm1 
    … …  
    442441      END DO 
    443442 
    444       ! horizontal derivative of density anomalies (rd) 
    445       IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
     443      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
     444         ! 
    446445         pgrui(:,:)  =0.0_wp ; pgrvi(:,:)  =0.0_wp ; 
    447446         pgzui(:,:)  =0.0_wp ; pgzvi(:,:)  =0.0_wp ; 
    448447         pmrui(:,:)  =0.0_wp ; pmrui(:,:)  =0.0_wp ; 
    449448         pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ; 
    450  
    451          DO jj = 1, jpjm1 
     449         ! 
     450         DO jj = 1, jpjm1        ! depth of the partial step level 
    452451            DO ji = 1, jpim1 
    453452               iku = miku(ji,jj) 
    … …  
    455454               ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
    456455               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    457  
     456               ! 
    458457               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu    ! i-direction: case 1 
    459458               ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) - ze3wu    ! -     -      case 2 
    … …  
    464463            END DO 
    465464         END DO 
    466  
    467          ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    468          ! step and store it in  zri, zrj for each  case 
    469          CALL eos( zti, zhi, zri )   
    470          CALL eos( ztj, zhj, zrj ) 
    471  
    472          ! Gradient of density at the last level  
    473          DO jj = 1, jpjm1 
     465         ! 
     466         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
     467         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
     468         ! 
     469         DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    474470            DO ji = 1, jpim1 
    475471               iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 
    … …  
    482478                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1  
    483479                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  & 
    484                                 * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   & 
    485                                    - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1 
     480                    &           * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   & 
     481                    &              - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1 
    486482               ELSE 
    487483                 pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 
    … …  
    489485                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2 
    490486                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   & 
    491                                 * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  & 
    492                                    -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2 
     487                    &           * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  & 
     488                    &              -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2 
    493489               ENDIF 
    494490               IF( ze3wv >= 0._wp ) THEN 
    … …  
    497493                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1 
    498494                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  &  
    499                                 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  & 
    500                                    - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1 
     495                     &           * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  & 
     496                     &                - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1 
    501497                                  ! + 2 due to the formulation in density and not in anomalie in hpg sco 
    502498               ELSE 
    … …  
    505501                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2 
    506502                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   & 
    507                                 * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 
    508                                    -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
     503                    &           * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 
     504                    &              -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
    509505               ENDIF 
    510506            END DO 
    … …  
    517513      END IF   
    518514      ! 
    519       IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_isf') 
     515      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf') 
    520516      ! 
    521517   END SUBROUTINE zps_hde_isf 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90

    r5215 r5758  
    1919   USE trd_oce         ! trends: ocean variables 
    2020   USE phycst          ! physical constants 
    21    USE ldftra_oce      ! ocean active tracers: lateral physics 
     21   USE ldftra          ! ocean active tracers: lateral physics 
    2222   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    2323   USE zdf_oce         ! ocean vertical physics 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5737 r5758  
    1717!!gm   USE dynhpg          ! hydrostatic pressure gradient    
    1818   USE zdfbfr         ! bottom friction 
    19    USE ldftra_oce     ! ocean active tracers lateral physics 
     19   USE ldftra         ! ocean active tracers lateral physics 
    2020   USE sbc_oce        ! surface boundary condition: ocean 
    2121   USE phycst         ! physical constants 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r5656 r5758  
    2222   USE trd_oce         ! trends: ocean variables 
    2323   USE trdmxl_oce      ! ocean variables trends 
    24    USE ldftra_oce      ! ocean active tracers lateral physics 
     24   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2525   USE zdf_oce         ! ocean vertical physics 
    2626   USE in_out_manager  ! I/O manager 
    … …  
    7373   !! * Substitutions 
    7474#  include "domzgr_substitute.h90" 
    75 #  include "ldftra_substitute.h90" 
    7675#  include "zdfddm_substitute.h90" 
    7776   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r5656 r5758  
    1717   USE trd_oce        ! trends: ocean variables 
    1818   USE eosbn2         ! equation of state and related derivatives 
    19    USE ldftra_oce     ! ocean active tracers lateral physics 
     19   USE ldftra         ! ocean active tracers lateral physics 
    2020   USE zdfddm         ! vertical physics: double diffusion 
    2121   USE phycst         ! physical constants 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r4990 r5758  
    2323   USE trdpen         ! trends: Potential ENergy 
    2424   USE trdmxl         ! ocean active mixed layer tracers trends  
    25    USE ldftra_oce     ! ocean active tracers lateral physics 
     25   USE ldftra         ! ocean active tracers lateral physics 
     26   USE ldfslp 
    2627   USE zdfddm         ! vertical physics: double diffusion 
    2728   USE phycst         ! physical constants 
     29   ! 
    2830   USE in_out_manager ! I/O manager 
    2931   USE iom            ! I/O manager library 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r4990 r5758  
    77   !! History :  OPA  !  1997-06  (G. Madec, A. Lazar)  Original code 
    88   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module 
    9    !!             -   !  2005-06  (C. Ethe) KPP parameterization 
    109   !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after 
    1110   !!---------------------------------------------------------------------- 
    … …  
    1817   USE dom_oce         ! ocean space and time domain variables 
    1918   USE zdf_oce         ! ocean vertical physics variables 
    20    USE zdfkpp          ! KPP vertical mixing 
    2119   USE in_out_manager  ! I/O manager 
    2220   USE iom             ! for iom_put 
    … …  
    8078            DO jj = 2, jpj             ! no vector opt. 
    8179               DO ji = 2, jpi 
    82 #if defined key_zdfkpp 
    83                   ! no evd mixing in the boundary layer with KPP 
    84                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  ) THEN 
    85 #else 
    8680                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    87 #endif 
    8881                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    8982                     avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    … …  
    107100            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call) 
    108101               DO ji = 1, jpi 
    109 #if defined key_zdfkpp 
    110                   ! no evd mixing in the boundary layer with KPP 
    111                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &           
    112 #else 
    113102                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    114 #endif 
    115103                     avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk) 
    116104               END DO 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r5386 r5758  
    66   !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix 
    77   !!            1.0  ! 2002-08  (G. Madec)  F90 : free form 
    8    !!             -   ! 2005-06  (C. Ethe) KPP parameterization 
    98   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection 
    109   !!---------------------------------------------------------------------- 
    … …  
    1413   !!---------------------------------------------------------------------- 
    1514   USE par_oce         ! mesh and scale factors 
    16    USE ldftra_oce      ! ocean active tracers: lateral physics 
    17    USE ldfdyn_oce      ! ocean dynamics lateral physics 
     15!!gm   USE ldftra          ! ocean active tracers: lateral physics 
     16!!gm   USE ldfdyn_oce      ! ocean dynamics lateral physics 
    1817   USE zdf_oce         ! TKE vertical mixing           
    1918   USE lib_mpp         ! distribued memory computing 
    2019   USE zdftke          ! TKE vertical mixing 
    2120   USE zdfgls          ! GLS vertical mixing 
    22    USE zdfkpp          ! KPP vertical mixing           
    2321   USE zdfddm          ! double diffusion mixing       
    2422   USE zdfevd          ! enhanced vertical diffusion   
    … …  
    111109         ioptio = ioptio+1 
    112110      ENDIF 
    113       IF( lk_zdfkpp ) THEN 
    114          IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients' 
    115          ioptio = ioptio+1 
    116       ENDIF 
    117111      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   & 
    118112         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 
    119       IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav )   & 
     113      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   & 
    120114         &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' ) 
    121115      ! 
    … …  
    143137         IF(lwp) WRITE(numout,*) '      use the GLS closure scheme' 
    144138      ENDIF 
    145       IF( lk_zdfkpp ) THEN 
    146          IF(lwp) WRITE(numout,*) '      use the KPP closure scheme' 
    147          IF(lk_mpp) THEN 
    148             IF(lwp) WRITE(numout,cform_err) 
    149             IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI' 
    150          ENDIF 
    151       ENDIF 
    152139      IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 
    153       IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           & 
    154          CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   & 
     140      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           & 
     141         CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   & 
    155142         &              ' required: ln_zdfevd or ln_zdfnpc logicals' ) 
    156143 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5656 r5758  
    2828   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     30   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 
     31   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
     32   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     33   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication  
     34   !!            3.7  ! 2014-12  (G. Madec) suppression of cross land advection option 
     35   !!             -   ! 2014-12  (G. Madec) remove KPP scheme 
    3236   !!---------------------------------------------------------------------- 
    3337 
    … …  
    8185   USE sbctide, ONLY: lk_tide 
    8286   USE crsini          ! initialise grid coarsening utility 
    83    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     87   USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges  
    8488   USE sbc_oce, ONLY: lk_oasis 
    8589   USE stopar 
    … …  
    96100 
    97101   !!---------------------------------------------------------------------- 
    98    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     102   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    99103   !! $Id$ 
    100104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    363367         WRITE(numout,*) '                       NEMO team' 
    364368         WRITE(numout,*) '            Ocean General Circulation Model' 
    365          WRITE(numout,*) '                  version 3.6  (2015) ' 
     369         WRITE(numout,*) '                  version 3.7  (2015) ' 
    366370         WRITE(numout,*) 
    367371         WRITE(numout,*) 
    … …  
    396400                            CALL     dom_cfg    ! Domain configuration 
    397401                            CALL     dom_init   ! Domain 
    398  
    399       IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    400  
     402      IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization  
     403      IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 
    401404      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    402  
    403405                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    404406 
    405       IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics 
    406  
    407                             CALL     sbc_init   ! Forcings : surface module (clem: moved here for bdy purpose) 
    408  
     407      !                                      ! external forcing  
     408!!gm to be added : creation and call of sbc_apr_init 
     409      IF( lk_tide       )   CALL    tide_init( nit000 )    ! tidal harmonics 
     410                            CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
     411!!gm ==>> bdy_init should call bdy_dta_init and bdytide_init  NOT nemogcm !!! 
    409412      IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation 
    410413      IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays 
    411414      IF( lk_bdy .AND. lk_tide )   & 
    412415         &                  CALL bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing 
    413  
    414                             CALL dyn_nept_init  ! simplified form of Neptune effect 
    415       !      
    416       IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid 
    417       ! 
    418                                 ! Ocean physics 
     416          
     417      !                                      ! Ocean physics 
    419418      !                                         ! Vertical physics 
    420419                            CALL     zdf_init      ! namelist read 
    … …  
    423422      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
    424423      IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme 
    425       IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme 
    426424      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing 
    427       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    428          &                  CALL zdf_ddm_init      ! double diffusive mixing 
     425      IF( lk_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing 
     426          
    429427      !                                         ! Lateral physics 
    430428                            CALL ldf_tra_init      ! Lateral ocean tracer physics 
     429                            CALL ldf_eiv_init      ! eddy induced velocity param. 
    431430                            CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    432       IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing 
    433  
    434       !                                     ! Active tracers 
    435                             CALL tra_qsr_init   ! penetrative solar radiation qsr 
    436                             CALL tra_bbc_init   ! bottom heat flux 
    437       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    438                             CALL tra_dmp_init   ! internal damping trends- tracers 
    439                             CALL tra_adv_init   ! horizontal & vertical advection 
    440                             CALL tra_ldf_init   ! lateral mixing 
    441                             CALL tra_zdf_init   ! vertical mixing and after tracer fields 
    442  
    443       !                                     ! Dynamics 
    444       IF( lk_c1d        )   CALL dyn_dmp_init   ! internal damping trends- momentum 
    445                             CALL dyn_adv_init   ! advection (vector or flux form) 
    446                             CALL dyn_vor_init   ! vorticity term including Coriolis 
    447                             CALL dyn_ldf_init   ! lateral mixing 
    448                             CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure 
    449                             CALL dyn_zdf_init   ! vertical diffusion 
    450                             CALL dyn_spg_init   ! surface pressure gradient 
    451  
    452       !                                     ! Misc. options 
     431 
     432      !                                         ! Active tracers 
     433                            CALL tra_qsr_init      ! penetrative solar radiation qsr 
     434                            CALL tra_bbc_init      ! bottom heat flux 
     435      IF( lk_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
     436                            CALL tra_dmp_init      ! internal tracer damping 
     437                            CALL tra_adv_init      ! horizontal & vertical advection 
     438                            CALL tra_ldf_init      ! lateral mixing 
     439                            CALL tra_zdf_init      ! vertical mixing and after tracer fields 
     440 
     441      !                                         ! Dynamics 
     442      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping 
     443                            CALL dyn_adv_init      ! advection (vector or flux form) 
     444                            CALL dyn_vor_init      ! vorticity term including Coriolis 
     445                            CALL dyn_ldf_init      ! lateral mixing 
     446                            CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
     447                            CALL dyn_zdf_init      ! vertical diffusion 
     448                            CALL dyn_spg_init      ! surface pressure gradient 
     449 
     450#if defined key_top 
     451      !                                      ! Passive tracers 
     452                            CALL     trc_init 
     453#endif 
     454      IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing 
     455 
     456      !                                      ! Icebergs 
     457                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     458 
     459      !                                      ! Misc. options 
    453460      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection 
    454                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    455461                            CALL sto_par_init   ! Stochastic parametrization 
    456462      IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations 
    457463      
    458 #if defined key_top 
    459       !                                     ! Passive tracers 
    460                             CALL     trc_init 
    461 #endif 
    462       !                                     ! Diagnostics 
     464      !                                      ! Diagnostics 
    463465      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    464466      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    … …  
    471473                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    472474      ENDIF 
    473  
    474       !                                     ! Assimilation increments 
     475      !                                      ! Assimilation increments 
    475476      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    476477      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    610611      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    611612      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    612  
    613613      ! 
    614614      numout = 6                                     ! redefine numout in case it is used after this point... 
    … …  
    628628      USE dom_oce   , ONLY: dom_oce_alloc 
    629629      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 
    630       USE ldftra_oce, ONLY: ldftra_oce_alloc 
    631630      USE trc_oce   , ONLY: trc_oce_alloc 
    632631#if defined key_diadct  
    … …  
    644643      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    645644      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics 
    646       ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers 
    647645      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics 
    648646      ! 
    … …  
    726724      INTEGER, DIMENSION(ntest) :: ilfax 
    727725      !!---------------------------------------------------------------------- 
     726      ! 
    728727      ! lfax contains the set of allowed factors. 
    729728      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    730  
     729      ! 
    731730      ! Clear the error flag and initialise output vars 
    732       kerr = 0 
    733       kfax = 1 
     731      kerr  = 0 
     732      kfax  = 1 
    734733      knfax = 0 
    735  
     734      ! 
    736735      ! Find the factors of n. 
    737736      IF( kn == 1 )   GOTO 20 
    … …  
    741740      ! l points to the allowed factor list. 
    742741      ! ifac holds the current factor. 
    743  
     742      ! 
    744743      inu   = kn 
    745744      knfax = 0 
    746  
     745      ! 
    747746      DO jl = ntest, 1, -1 
    748747         ! 
    … …  
    768767         ! 
    769768      END DO 
    770  
     769      ! 
    771770   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    772771      ! 
    … …  
    776775 
    777776   SUBROUTINE nemo_northcomms 
    778       !!====================================================================== 
     777      !!---------------------------------------------------------------------- 
    779778      !!                     ***  ROUTINE  nemo_northcomms  *** 
    780       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    781       !!                       point-to-point messaging 
    782       !!===================================================================== 
    783       !!---------------------------------------------------------------------- 
    784       !! 
    785       !! ** Purpose :   Initialization of the northern neighbours lists. 
     779      !! ** Purpose :   Setup for north fold exchanges with explicit  
     780      !!                point-to-point messaging 
     781      !! 
     782      !! ** Method :   Initialization of the northern neighbours lists. 
    786783      !!---------------------------------------------------------------------- 
    787784      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    788785      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    789786      !!---------------------------------------------------------------------- 
    790  
    791787      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    792788      INTEGER  ::   njmppmax 
     789      !!---------------------------------------------------------------------- 
    793790 
    794791      njmppmax = MAXVAL( njmppt ) 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4990 r5758  
    1616   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
    1717 
    18    LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion 
    1918 
    2019   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5656 r5758  
    2424   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    2525   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal 
    26    !!                 !  2012-07  (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs 
    27    !!            3.7  !  2014-04  (F. Roquet, G. Madec) New equations of state 
     26   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs 
     27   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state 
     28   !!            3.7  !  2014-10  (G. Madec)  LDF simplication  
     29   !!             -   !  2014-12  (G. Madec) remove KPP scheme 
    2830   !!---------------------------------------------------------------------- 
    2931 
    … …  
    3739   PRIVATE 
    3840 
    39    PUBLIC   stp   ! called by opa.F90 
     41   PUBLIC   stp   ! called by nemogcm.F90 
    4042 
    4143   !! * Substitutions 
    … …  
    4345!!gm   #  include "zdfddm_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     47   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4648   !! $Id$ 
    4749   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7678      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt) 
    7779      !! --------------------------------------------------------------------- 
    78  
    7980#if defined key_agrif 
    8081      kstp = nit000 + Agrif_Nb_Step() 
    81       IF ( lk_agrif_debug ) THEN 
    82          IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    83          IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
    84       ENDIF 
    85  
    86       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    87  
     82      IF( lk_agrif_debug ) THEN 
     83         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---' 
     84         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 
     85      ENDIF 
     86      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE. 
    8887# if defined key_iomput 
    8988      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    9089# endif 
    9190#endif 
    92                              indic = 0           ! reset to no error condition 
    93       IF( kstp == nit000 ) THEN 
    94          ! must be done after nemo_init for AGRIF+XIOS+OASIS 
    95                       CALL iom_init(      cxios_context          )  ! iom_put initialization 
    96          IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid 
    97       ENDIF 
    98  
     91      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     92      ! update I/O and calendar  
     93      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     94                             indic = 0                ! reset to no error condition 
     95                              
     96      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     97                             CALL iom_init(      cxios_context          )  ! for model grid (including passible AGRIF zoom) 
     98         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid 
     99      ENDIF 
    99100      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    100                              CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp 
    101       IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp 
    102  
    103       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    104       ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    105       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    106       IF( lk_tide    )   CALL sbc_tide( kstp ) 
    107       IF( lk_bdy     )  THEN 
    108          IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib  
    109                          CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    110       ENDIF 
    111                          CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    112                                                       ! clem: moved here for bdy ice purpose 
     101                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp 
     102      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp 
     103 
     104      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     105      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice) 
     106      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     107      IF( lk_tide    )   CALL sbc_tide( kstp )                   ! update tide potential 
     108      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)  
     109      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     110                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice) 
     111CALL FLUSH    ( numout ) 
    113112      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    114113      ! Update stochastic parameters and random T/S fluctuations 
    115114      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    116                         CALL sto_par( kstp )          ! Stochastic parameters 
     115                         CALL sto_par( kstp )          ! Stochastic parameters 
     116CALL FLUSH    ( numout ) 
    117117 
    118118      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    124124                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
    125125                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
     126CALL FLUSH    ( numout ) 
    126127      ! 
    127128      !  VERTICAL PHYSICS 
    … …  
    131132      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz 
    132133      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    133       IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz 
    134134      IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value) 
    135135         avt (:,:,:) = rn_avt0 * wmask (:,:,:) 
    … …  
    137137         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 
    138138      ENDIF 
     139CALL FLUSH    ( numout ) 
    139140      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
    140          DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
     141         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    141142      ENDIF 
    142143      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    … …  
    144145      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
    145146 
    146       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    147          &               CALL zdf_ddm( kstp )         ! double diffusive mixing 
     147      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing 
    148148 
    149149                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    … …  
    152152      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
    153153      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
     154CALL FLUSH    ( numout ) 
    154155      ! 
    155156      !  LATERAL  PHYSICS 
    156157      ! 
    157       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
     158      IF( l_ldfslp ) THEN                             ! slope of lateral mixing 
     159!!gm : why this here ???? 
    158160         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations 
     161!!gm 
    159162                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
     163 
    160164         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    161165            &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    162166            &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     167 
    163168         IF( ln_zps .AND.       ln_isfcav)                               & 
    164             &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, &    ! Partial steps for top cell (ISF) 
     169            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi,  &    ! Partial steps for top cell (ISF) 
    165170            &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    166             &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level 
    167          IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator 
    168                          CALL ldf_slp_grif( kstp ) 
    169          ELSE 
    170                          CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator 
     171            &                                   grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level 
     172 
     173         IF( ln_traldf_triad ) THEN  
     174                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator 
     175         ELSE      
     176                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator 
    171177         ENDIF 
    172178      ENDIF 
    173 #if defined key_traldf_c2d 
    174       IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient 
    175 #endif 
    176 #if defined key_traldf_c3d && defined key_traldf_smag 
    177                           CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient 
    178 #  endif 
    179 #if defined key_dynldf_c3d && defined key_dynldf_smag 
    180                           CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient 
    181 #  endif 
     179      !                                               ! eddy diffusivity coeff. and/or eiv coeff. 
     180      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp )  
     181write(*,*) 'after ldf_slp' 
     182CALL FLUSH    ( numout ) 
    182183 
    183184      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    187188      IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors  
    188189                         CALL wzv           ( kstp )  ! now cross-level velocity  
     190write(*,*) 'after wzv' 
     191CALL FLUSH    ( numout ) 
    189192 
    190193      IF( lk_dynspg_ts ) THEN  
    … …  
    192195          ! Note that the computation of vertical velocity above, hence "after" sea level 
    193196          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
     197!!gm : why also here ???? 
    194198            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
     199!!gm 
    195200                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    196             IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    197                &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
    198                &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    199             IF( ln_zps .AND.       ln_isfcav)                               & 
    200                &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     201                             
     202            IF( ln_zps .AND. .NOT. ln_isfcav)   &                           ! Partial steps: bottom before horizontal gradient 
     203               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &  ! of t, s, rd at the last ocean level 
     204               &                                          rhd, gru , grv    ) 
     205            IF( ln_zps .AND.       ln_isfcav)   &                           ! Partial steps: top & bottom before horizontal gradient 
     206               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,   &  
    201207               &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    202                &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
    203  
    204                                   ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    205                                   va(:,:,:) = 0.e0 
     208               &                                               grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
     209 
     210                                  ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
     211                                  va(:,:,:) = 0._wp 
    206212          IF(  lk_asminc .AND. ln_asmiau .AND. & 
    207213             & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment 
    … …  
    225231                                  CALL wzv           ( kstp )  ! now cross-level velocity  
    226232      ENDIF 
     233write(*,*) 'after wzv 2' 
     234CALL FLUSH    ( numout ) 
    227235 
    228236      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    229237      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    230238      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    231       IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats 
    232       IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    233       IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    234       IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports 
    235       IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
    236       IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    237                             CALL dia_wri( kstp )         ! ocean model: outputs 
    238       ! 
    239       IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
     239      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
     240      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
     241      IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     242      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
     243      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 
     244      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
     245                         CALL dia_wri( kstp )         ! ocean model: outputs 
     246      ! 
     247      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    240248 
    241249#if defined key_top 
    … …  
    245253                         CALL trc_stp( kstp )         ! time-stepping 
    246254#endif 
    247  
     255write(*,*) 'end dyn ' 
     256CALL FLUSH    ( numout ) 
    248257 
    249258      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    250259      ! Active tracers                              (ua, va used as workspace) 
    251260      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    252                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
     261                             tsa(:,:,:,:) = 0._wp           ! set tracer trends to zero 
    253262 
    254263      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    261270      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends 
    262271                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    263       IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
     272write(*,*) 'before tra_ldf' 
     273CALL FLUSH    ( numout ) 
    264274                             CALL tra_ldf    ( kstp )       ! lateral mixing 
    265  
     275write(*,*) 'after tra_ldf' 
     276CALL FLUSH    ( numout ) 
     277 
     278!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    266279      IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics 
     280!!gm 
    267281 
    268282#if defined key_agrif 
    … …  
    274288         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    275289                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     290!!gm : why again a call to sto_pts ??? 
    276291            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
     292!!gm 
    277293                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    278294            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    … …  
    280296               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    281297            IF( ln_zps .AND.       ln_isfcav)                                & 
    282                &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     298               &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, gtui, gtvi,  &    ! Partial steps for top/bottom cells 
    283299               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    284                &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
     300               &                                                grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
    285301      ELSE                                                  ! centered hpg  (eos then time stepping) 
    286302         IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
     303!!gm : why again a call to sto_pts ??? 
    287304            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
     305!!gm 
    288306                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
    289307         IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 
    290                &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
    291                &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     308               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: bottom before horizontal gradient 
     309               &                                           rhd, gru , grv    )    ! of t, s, rd at the last ocean level 
    292310         IF( ln_zps .AND.       ln_isfcav)                                   &  
    293                &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     311               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,   &    ! Partial steps for top/bottom cells 
    294312               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    295                &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
     313               &                                    grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
    296314         ENDIF 
    297315         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    298316                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    299317      ENDIF 
     318write(*,*) 'after tra_nxt' 
     319CALL FLUSH    ( numout ) 
    300320 
    301321      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    315335                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    316336      ELSE 
    317                                ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    318                                va(:,:,:) = 0.e0 
     337                               ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
     338                               va(:,:,:) = 0._wp 
    319339 
    320340        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    340360      IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
    341361      ! 
     362write(*,*) 'after dom_vvl' 
     363CALL FLUSH    ( numout ) 
     364 
     365 
     366!!gm : This does not only concern the dynamics ==>>> add a new title 
     367!!gm2: why ouput restart before AGRIF update? 
    342368      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file 
    343369 
    … …  
    367393                 CALL iom_close( numror )     ! close input  ocean restart file 
    368394         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce 
    369          IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice 
     395         IF(lwm.AND.numoni /= -1 )   & 
     396            &    CALL FLUSH    ( numoni )     ! flush output namelist ice (if exist) 
    370397      ENDIF 
    371398 
    … …  
    373400      ! Coupled mode 
    374401      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     402!!gm why lk_oasis and not lk_cpl ???? 
    375403      IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    376404      ! 
    … …  
    383411      ! 
    384412      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
    385       !      
    386413      ! 
    387414   END SUBROUTINE stp 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5656 r5758  
    99   USE dom_oce          ! ocean space and time domain variables 
    1010   USE zdf_oce          ! ocean vertical physics variables 
    11    USE ldftra_oce       ! ocean tracer   - trends 
     11   USE ldftra           ! ocean tracer   - trends 
    1212   USE ldfdyn_oce       ! ocean dynamics - trends 
    1313   USE divcur           ! hor. divergence and curl      (div & cur routines) 
    … …  
    2222   USE daymod           ! calendar                         (day     routine) 
    2323 
    24    USE sbcmod           ! surface boundary condition       (sbc     routine) 
    25    USE sbcrnf           ! surface boundary condition: runoff variables 
    26    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
    2724   USE sbc_oce          ! surface boundary condition: ocean 
    28    USE sbctide          ! Tide initialisation 
    29    USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta  
     25   USE sbcrnf           !    -       -        -     : runoff variables 
     26   USE sbcmod           !    -       -        -            (sbc      routine) 
     27   USE sbcapr           !    -       -        -            (sbc_apr  routine) 
     28   USE sbctide          !    -       -        -            (sbc_tide routine) 
     29   USE sbccpl           !    -       -        -     : coupled formulation (call send at end of step) 
    3030 
    3131   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 
    … …  
    3636   USE traadv           ! advection scheme control     (tra_adv_ctl routine) 
    3737   USE traldf           ! lateral mixing                   (tra_ldf routine) 
    38    !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine) 
    3938   USE trazdf           ! vertical mixing                  (tra_zdf routine) 
    4039   USE tranxt           ! time-stepping                    (tra_nxt routine) 
    … …  
    7170 
    7271   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine) 
    73    USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine) 
    74    USE ldftra_smag      ! Smagirinsky diffusion            (ldftra_smag routine) 
    75    USE ldfdyn_smag      ! Smagorinsky viscosity            (ldfdyn_smag routine)  
    7672 
    7773   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine) 
    … …  
    7975   USE zdftke           ! TKE vertical mixing              (zdf_tke routine) 
    8076   USE zdfgls           ! GLS vertical mixing              (zdf_gls routine) 
    81    USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine) 
    8277   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine) 
    8378   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine) 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5385 r5758  
    2525   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    2626   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     27   USE ldftra          ! lateral diffusion coefficient on tracers 
    2828   USE prtctl_trc      ! Print control 
    2929 
    … …  
    6868      !! ** Method  : - Update the tracer with the advection term following nadv 
    6969      !!---------------------------------------------------------------------- 
    70       !! 
    7170      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7271      ! 
    … …  
    7675      !!---------------------------------------------------------------------- 
    7776      ! 
    78       IF( nn_timing == 1 )  CALL timing_start('trc_adv') 
     77      IF( nn_timing == 1 )   CALL timing_start('trc_adv') 
    7978      ! 
    80       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     79      CALL wrk_alloc( jpi,jpj,jpk,  zun, zvn, zwn ) 
    8180      ! 
    8281 
    … …  
    8887         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    8988      ENDIF 
    90       !                                                   ! effective transport 
     89      !                                               !==  effective transport  ==! 
     90      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     91      zvn(:,:,jpk) = 0._wp 
     92      zwn(:,:,jpk) = 0._wp 
    9193      DO jk = 1, jpkm1 
    92          !                                                ! eulerian transport only 
    93          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     94         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    9495         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    9596         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    96          ! 
    9797      END DO 
    9898      ! 
    99       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
     99      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    100100         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    101101         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    102102      ENDIF 
    103103      ! 
    104       zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    105       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    106       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    107  
    108       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
    109          &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
     104      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     105         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
    110106      ! 
    111       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary) 
     107      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     108      ! 
    112109      ! 
    113110      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
     111      ! 
    114112      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    115113      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    … …  
    119117      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    120118      ! 
    121       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    122          CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    123          WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    124                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    126          WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    127                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    129          WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    130                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    132          WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    133                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    134          CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    135          WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    136                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    137          CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    138          WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    139                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    140          ! 
    141119      END SELECT 
    142  
    143       !                                              ! print mean trends (used for debugging) 
    144       IF( ln_ctl )   THEN 
     120      !                   
     121      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging) 
    145122         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout) 
    146123                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    147124      END IF 
    148125      ! 
    149       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     126      CALL wrk_dealloc( jpi,jpj,jpk,  zun, zvn, zwn ) 
    150127      ! 
    151128      IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
    … …  
    163140      INTEGER ::   ioptio 
    164141      !!---------------------------------------------------------------------- 
    165  
     142      ! 
    166143      ioptio = 0                      ! Parameter control 
    167144      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1 
    … …  
    171148      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1 
    172149      IF( ln_trcadv_qck    )   ioptio = ioptio + 1 
    173       IF( lk_esopa         )   ioptio =          1 
    174  
     150      ! 
    175151      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 
    176  
     152      ! 
    177153      !                              ! Set nadv 
    178154      IF( ln_trcadv_cen2   )   nadv =  1 
    … …  
    182158      IF( ln_trcadv_ubs    )   nadv =  5 
    183159      IF( ln_trcadv_qck    )   nadv =  6 
    184       IF( lk_esopa         )   nadv = -1 
    185  
     160      ! 
    186161      IF(lwp) THEN                   ! Print the choice 
    187162         WRITE(numout,*) 
    … …  
    192167         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
    193168         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
    194          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    195169      ENDIF 
    196170      ! 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5385 r5758  
    44   !! Ocean Passive 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 :  1.0  ! 2005-11  (G. Madec)  Original code 
     7   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     8   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    14    !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    15    !!       ldf_ctl : initialization, namelist read, and parameters control 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc         ! ocean dynamics and active tracers 
    18    USE trc             ! ocean passive tracers variables 
    19    USE trcnam_trp      ! passive tracers transport namelist variables 
    20    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    21    USE ldfslp          ! ??? 
    22    USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    23    USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    24    USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
    25    USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    26    USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    27    USE trd_oce 
    28    USE trdtra 
     14   !!   trc_ldf      : update the tracer trend with the lateral diffusion 
     15   !!       ldf_ctl  : initialization, namelist read, and parameters control 
     16   !!---------------------------------------------------------------------- 
     17   USE trc           ! ocean passive tracers variables 
     18   USE oce_trc       ! ocean dynamics and active tracers 
     19   USE trcnam_trp    ! passive tracers transport namelist variables 
     20   USE ldfslp        ! lateral diffusion: iso-neutral slope 
     21   USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine) 
     22   USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine) 
     23   USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine) 
     24   USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine) 
     25   USE trd_oce       ! trends: ocean variables 
     26   USE trdtra        ! trends manager: tracers  
     27   ! 
    2928   USE prtctl_trc      ! Print control 
    3029 
    … …  
    3231   PRIVATE 
    3332 
    34    PUBLIC   trc_ldf    ! called by step.F90 
     33   PUBLIC   trc_ldf    ! called by trctrp.F90 
    3534   !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    3635   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
    3736   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     37    
    3838   !! * Substitutions 
    3939#  include "domzgr_substitute.h90" 
    4040#  include "vectopt_loop_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
    42    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/TOP 3.7 , NEMO Consortium (2014) 
    4343   !! $Id$ 
    4444   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    46  
    4746CONTAINS 
    4847 
    … …  
    5857      INTEGER            :: jn 
    5958      CHARACTER (len=22) :: charout 
     59      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv 
    6060      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    6161      !!---------------------------------------------------------------------- 
    … …  
    6363      IF( nn_timing == 1 )   CALL timing_start('trc_ldf') 
    6464      ! 
     65       
     66!!gm  this call should be put in trcini ! 
    6567      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
    66  
    67       rldf = rldf_rat 
     68!!gm end 
    6869 
    6970      IF( l_trdtrc )  THEN 
    70          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     71         CALL wrk_alloc( jpi,jpj,jpk,jptra,  ztrtrd ) 
    7172         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    7273      ENDIF 
    7374 
    74       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    75       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra        )  ! iso-level laplacian 
    76       CASE ( 1 )                                                                                            ! rotated laplacian 
    77                        IF( ln_traldf_grif ) THEN 
    78                           CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    79                        ELSE 
    80                           CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    81                        ENDIF 
    82       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian 
    83       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    84          ! 
    85       CASE ( -1 )                                     ! esopa: test all possibility with control print 
    86          CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    87          WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    88                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    89          IF( ln_traldf_grif ) THEN 
    90             CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    91          ELSE 
    92             CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    93          ENDIF 
    94          WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    95                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96          CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    97          WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    98                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    99          CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    100          WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    101                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     75      !                                        ! set the lateral diffusivity coef. for passive tracer       
     76      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv ) 
     77      zahu(:,:,:) = rldf_rat * ahtu(:,:,:) 
     78      zahv(:,:,:) = rldf_rat * ahtv(:,:,:) 
     79 
     80      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend 
     81      ! 
     82      CASE ( n_lap   )                                ! iso-level laplacian 
     83         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   ) 
     84         ! 
     85      CASE ( n_lap_i )                                ! laplacian : standard iso-neutral operator (Madec) 
     86         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     87         ! 
     88      CASE ( n_lap_it )                               ! laplacian : triad iso-neutral operator (griffies) 
     89         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     90         ! 
     91      CASE ( n_blp , n_blp_i , n_blp_it )             ! bilaplacian: all operator (iso-level, -neutral) 
     92         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf ) 
     93         ! 
    10294      END SELECT 
    10395      ! 
    104       IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     96      IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics 
    10597        DO jn = 1, jptra 
    10698           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    … …  
    109101        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    110102      ENDIF 
    111       !                                          ! print mean trends (used for debugging) 
    112       IF( ln_ctl )   THEN 
    113          WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout) 
    114                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    115       ENDIF 
     103      !                                        ! print mean trends (used for debugging) 
     104      IF( ln_ctl ) THEN 
     105         WRITE(charout, FMT="('ldf ')")   ;   CALL prt_ctl_trc_info(charout) 
     106                                              CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     107      ENDIF 
     108      ! 
     109      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv ) 
    116110      ! 
    117111      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf') 
    … …  
    119113   END SUBROUTINE trc_ldf 
    120114 
     115!!gm ldf_ctl should be called in trcini  so that l_ldfslp=T  cause the slope init and calculation 
    121116 
    122117   SUBROUTINE ldf_ctl 
    … …  
    124119      !!                  ***  ROUTINE ldf_ctl  *** 
    125120      !! 
    126       !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
     121      !! ** Purpose :   Define the operator for the lateral diffusion 
    127122      !! 
    128123      !! ** Method  :   set nldf from the namtra_ldf logicals 
    129124      !!      nldf == -2   No lateral diffusion 
    130       !!      nldf == -1   ESOPA test: ALL operators are used 
    131125      !!      nldf ==  0   laplacian operator 
    132126      !!      nldf ==  1   Rotated laplacian operator 
    … …  
    136130      INTEGER ::   ioptio, ierr         ! temporary integers 
    137131      !!---------------------------------------------------------------------- 
    138  
    139       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    140          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    141             rldf_rat = 1.0_wp 
    142          ELSE 
    143             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    144          END IF 
    145       ELSE 
    146          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    147       END IF 
    148       !  Define the lateral mixing oparator for tracers 
    149       ! =============================================== 
    150  
    151       !                               ! control the input 
     132      !       
     133      !                                ! control the namelist parameters 
    152134      ioptio = 0 
    153       IF( ln_trcldf_lap   )   ioptio = ioptio + 1 
    154       IF( ln_trcldf_bilap )   ioptio = ioptio + 1 
    155       IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    156       IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion 
     135      IF( ln_trcldf_lap )   ioptio = ioptio + 1 
     136      IF( ln_trcldf_blp )   ioptio = ioptio + 1 
     137      IF( ioptio >  1 )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
     138      IF( ioptio == 0 )   nldf = n_no_ldf   ! No lateral diffusion 
     139       
     140      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
     141      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
     142       
    157143      ioptio = 0 
    158       IF( ln_trcldf_level )   ioptio = ioptio + 1 
    159       IF( ln_trcldf_hor   )   ioptio = ioptio + 1 
    160       IF( ln_trcldf_iso   )   ioptio = ioptio + 1 
    161       IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
     144      IF( ln_trcldf_lev )   ioptio = ioptio + 1 
     145      IF( ln_trcldf_hor )   ioptio = ioptio + 1 
     146      IF( ln_trcldf_iso )   ioptio = ioptio + 1 
     147      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    162148 
    163149      ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    164150      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    165151      ierr = 0 
    166       IF( ln_trcldf_lap ) THEN       ! laplacian operator 
     152      IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==! 
    167153         IF ( ln_zco ) THEN                ! z-coordinate 
    168             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    169             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    170             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    171          ENDIF 
    172          IF ( ln_zps ) THEN             ! z-coordinate 
    173             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    174             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    175             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    176          ENDIF 
    177          IF ( ln_sco ) THEN             ! z-coordinate 
    178             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    179             IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    180             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    181          ENDIF 
    182       ENDIF 
    183  
    184       IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator 
     154            IF ( ln_trcldf_lev   )   nldf = n_lap     ! iso-level = horizontal (no rotation) 
     155            IF ( ln_trcldf_hor   )   nldf = n_lap     ! iso-level = horizontal (no rotation) 
     156            IF ( ln_trcldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard  (   rotation) 
     157            IF ( ln_trcldf_triad )   nldf = n_lap_it  ! iso-neutral: triad     (   rotation) 
     158         ENDIF 
     159         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     160            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     161            IF ( ln_trcldf_hor   )   nldf = n_lap     ! horizontal (no rotation) 
     162            IF ( ln_trcldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard (rotation) 
     163            IF ( ln_trcldf_triad )   nldf = n_lap_it  ! iso-neutral: triad    (rotation) 
     164         ENDIF 
     165         IF ( ln_sco ) THEN             ! s-coordinate 
     166            IF ( ln_trcldf_lev   )   nldf = n_lap     ! iso-level  (no rotation) 
     167            IF ( ln_trcldf_hor   )   nldf = n_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
     168            IF ( ln_trcldf_iso   )   nldf = n_lap_i   ! iso-neutral: standard (rotation) 
     169            IF ( ln_trcldf_triad )   nldf = n_lap_it  ! iso-neutral: triad    (rotation) 
     170         ENDIF 
     171         !                                ! diffusivity ratio: passive / active tracers  
     172         IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 
     173            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     174               rldf_rat = 1.0_wp 
     175            ELSE 
     176               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     177            ENDIF 
     178         ELSE 
     179            rldf_rat = rn_ahtrc_0 / rn_aht_0 
     180         ENDIF 
     181      ENDIF 
     182 
     183      IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==! 
    185184         IF ( ln_zco ) THEN                ! z-coordinate 
    186             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    187             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    188             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    189          ENDIF 
    190          IF ( ln_zps ) THEN             ! z-coordinate 
    191             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    192             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    193             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    194          ENDIF 
    195          IF ( ln_sco ) THEN             ! z-coordinate 
    196             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    197             IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    198             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     185            IF ( ln_trcldf_lev   )   nldf = n_blp     ! iso-level = horizontal (no rotation) 
     186            IF ( ln_trcldf_hor   )   nldf = n_blp     ! iso-level = horizontal (no rotation) 
     187            IF ( ln_trcldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     188            IF ( ln_trcldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     189         ENDIF 
     190         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     191            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     192            IF ( ln_trcldf_hor   )   nldf = n_blp     ! horizontal (no rotation) 
     193            IF ( ln_trcldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     194            IF ( ln_trcldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     195         ENDIF 
     196         IF ( ln_sco ) THEN             ! s-coordinate 
     197            IF ( ln_trcldf_lev   )   nldf = n_blp     ! iso-level  (no rotation) 
     198            IF ( ln_trcldf_hor   )   nldf = n_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
     199            IF ( ln_trcldf_iso   )   nldf = n_blp_i   ! iso-neutral: standard (rotation) 
     200            IF ( ln_trcldf_triad )   nldf = n_blp_it  ! iso-neutral: triad    (rotation) 
     201         ENDIF 
     202         !                                ! diffusivity ratio: passive / active tracers  
     203         IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 
     204            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     205               rldf_rat = 1.0_wp 
     206            ELSE 
     207               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     208            ENDIF 
     209         ELSE 
     210            rldf_rat = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  ) 
    199211         ENDIF 
    200212      ENDIF 
    201213 
    202214      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    203       IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    204       IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   & 
     215      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   & 
    205216           CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    206217           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    207218      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    208          IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    209 #if defined key_offline 
    210          l_traldf_rot = .TRUE.                 ! needed for trazdf_imp 
    211 #endif 
    212       ENDIF 
    213  
    214       IF( lk_esopa ) THEN 
    215          IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    216          nldf = -1 
     219         IF( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' ) 
    217220      ENDIF 
    218221 
    219222      IF(lwp) THEN 
    220223         WRITE(numout,*) 
    221          IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion' 
    222          IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used' 
    223          IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator' 
    224          IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator' 
    225          IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator' 
    226          IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian' 
    227       ENDIF 
    228  
    229       IF( ln_trcldf_bilap ) THEN 
    230          IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    231          IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
    232       ELSE 
    233          IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    234          IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
    235       ENDIF 
    236  
    237       ! ratio between active and passive tracers diffusive coef. 
    238       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    239          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    240             rldf_rat = 1.0_wp 
    241          ELSE 
    242             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    243          END IF 
    244       ELSE 
    245          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    246       END IF 
    247       IF( rldf_rat < 0 ) THEN 
    248          IF( .NOT.lk_offline ) THEN  
    249             CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
    250          ELSE 
    251             CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
    252          ENDIF  
     224         IF( nldf == n_no_ldf )   WRITE(numout,*) '          NO lateral diffusion' 
     225         IF( nldf == n_lap    )   WRITE(numout,*) '          laplacian iso-level operator' 
     226         IF( nldf == n_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
     227         IF( nldf == n_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
     228         IF( nldf == n_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator' 
     229         IF( nldf == n_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
     230         IF( nldf == n_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
    253231      ENDIF 
    254232      ! 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r5385 r5758  
    3131   LOGICAL , PUBLIC ::   ln_trcadv_msc_ups   ! use upstream scheme within muscl 
    3232 
    33  
    3433   !                                        !!: ** lateral mixing namelist (nam_trcldf) ** 
    35    LOGICAL , PUBLIC ::   ln_trcldf_lap       !: laplacian operator 
    36    LOGICAL , PUBLIC ::   ln_trcldf_bilap     !: bilaplacian operator 
    37    LOGICAL , PUBLIC ::   ln_trcldf_level     !: iso-level direction 
    38    LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal (geopotential) direction 
    39    LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction 
    40    REAL(wp), PUBLIC ::   rn_ahtrc_0          !: diffusivity coefficient for passive tracer (m2/s) 
    41    REAL(wp), PUBLIC ::   rn_ahtrb_0          !: background diffusivity coefficient for passive tracer (m2/s) 
     34   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator 
     35   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator 
     36   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction 
     37   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential) 
     38   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard) 
     39   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad) 
     40   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s] 
     41   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          -        -     -       -   [m4/s] 
    4242 
    4343   !                                        !!: ** Treatment of Negative concentrations ( nam_trcrad ) 
    … …  
    5454 
    5555   !!---------------------------------------------------------------------- 
    56    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     56   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    5757   !! $Id$  
    5858   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5959   !!---------------------------------------------------------------------- 
    60  
    6160CONTAINS 
    6261 
    … …  
    6867      !!---------------------------------------------------------------------- 
    6968      INTEGER ::  ios                 ! Local integer output status for namelist read 
     69      !! 
    7070      NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd   ,    & 
    7171         &                 ln_trcadv_muscl, ln_trcadv_muscl2,    & 
    7272         &                 ln_trcadv_ubs  , ln_trcadv_qck, ln_trcadv_msc_ups 
    73  
    74       NAMELIST/namtrc_ldf/ ln_trcldf_lap  ,     & 
    75          &                 ln_trcldf_bilap, ln_trcldf_level,     & 
    76          &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0 
     73      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
     74         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
     75         &                 rn_ahtrc_0   , rn_bhtrc_0 
    7776      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    7877      NAMELIST/namtrc_rad/ ln_trcrad 
    … …  
    120119         WRITE(numout,*) '~~~~~~~~~~~' 
    121120         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 
    122          WRITE(numout,*) '      laplacian operator                                 ln_trcldf_lap   = ', ln_trcldf_lap 
    123          WRITE(numout,*) '      bilaplacian operator                               ln_trcldf_bilap = ', ln_trcldf_bilap 
    124          WRITE(numout,*) '      iso-level                                          ln_trcldf_level = ', ln_trcldf_level 
    125          WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor 
    126          WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso 
    127          WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0 
    128          WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0 
     121         WRITE(numout,*) '      operator' 
     122         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap 
     123         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp 
     124         WRITE(numout,*) '      direction of action' 
     125         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev 
     126         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor 
     127         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso 
     128         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad 
     129         WRITE(numout,*) '      diffusivity coefficient' 
     130         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0 
     131         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0 
    129132      ENDIF 
    130133 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5120 r5758  
    4848CONTAINS 
    4949 
    50    SUBROUTINE trc_trp( kstp ) 
     50   SUBROUTINE trc_trp( kt ) 
    5151      !!---------------------------------------------------------------------- 
    5252      !!                     ***  ROUTINE trc_trp  *** 
    … …  
    5757      !!              - Update the passive tracers 
    5858      !!---------------------------------------------------------------------- 
    59       INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
     59      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    6060      !! --------------------------------------------------------------------- 
    6161      ! 
    … …  
    6464      IF( .NOT. lk_c1d ) THEN 
    6565         ! 
    66                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    67          IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    68          IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    69          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    70                                 CALL trc_adv( kstp )            ! horizontal & vertical advection  
    71                                 CALL trc_ldf( kstp )            ! lateral mixing 
    72          IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    73             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     66                                CALL trc_sbc    ( kt )      ! surface boundary condition 
     67         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme 
     68         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
     69         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
     70                                CALL trc_adv    ( kt )      ! horizontal & vertical advection  
     71                                CALL trc_ldf    ( kt )      ! lateral mixing 
    7472#if defined key_agrif 
    75          IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
     73         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
    7674#endif 
    77                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    78                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    79          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     75                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields 
     76                                CALL trc_nxt    ( kt )      ! tracer fields at next time step      
     77         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations 
    8078 
    8179#if defined key_agrif 
    82       IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )  ! Update tracer at AGRIF zoom boundaries : children only 
     80      IF( .NOT.Agrif_Root())    CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 
    8381#endif 
    8482 
    85          IF( ln_zps  .AND. .NOT. ln_isfcav)        & 
    86             &            CALL zps_hde    ( kstp, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive 
    87          IF( ln_zps .AND.        ln_isfcav)        & 
    88             &            CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive 
    89                                                                 ! tracers at the bottom ocean level 
     83      !                                                         ! Partial top/bottom cell: GRADh( trn )   
     84      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, jptra, trn, gtru, gtrv, gtrui, gtrvi )  ! both top & bottom 
     85      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, jptra, trn, gtru, gtrv )                ! only bottom  
     86      ENDIF 
     87!!gm         IF( ln_zps ) THEN 
     88!            &            CALL zps_hde    ( kt, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive 
     89!            IF( ln_isfcav)        & 
     90!            &            CALL zps_hde_isf( kt, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive 
     91!!gm         ENDIF 
    9092         ! 
    9193      ELSE                                               ! 1D vertical configuration 
    92                                 CALL trc_sbc( kstp )            ! surface boundary condition 
     94                                CALL trc_sbc( kt )            ! surface boundary condition 
    9395         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    94             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
    95                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    96                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    97           IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     96            &                   CALL trc_kpp( kt )            ! KPP non-local tracer fluxes 
     97                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields 
     98                                CALL trc_nxt( kt )            ! tracer fields at next time step      
     99          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations 
    98100         ! 
    99101      END IF 
    … …  
    108110   !!---------------------------------------------------------------------- 
    109111CONTAINS 
    110    SUBROUTINE trc_trp( kstp )              ! Empty routine 
    111       INTEGER, INTENT(in) ::   kstp 
    112       WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 
     112   SUBROUTINE trc_trp( kt )              ! Empty routine 
     113      INTEGER, INTENT(in) ::   kt 
     114      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 
    113115   END SUBROUTINE trc_trp 
    114116#endif 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5385 r5758  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13  
    14    !* Domain size * 
     13   ! 
     14   !                                            !* Domain size * 
    1515   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
    1616   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
    … …  
    2424   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
    2525 
    26    !* IO manager * 
    27    USE in_out_manager     
    28   
    29    !* Memory Allocation * 
    30    USE wrk_nemo       
    31   
    32    !* Timing * 
    33    USE timing     
    34   
    35    !* MPP library                          
    36    USE lib_mpp  
    37  
    38    !* Fortran utilities                          
    39    USE lib_fortran 
    40  
    41    !* Lateral boundary conditions                          
    42    USE lbclnk 
    43  
    44    !* physical constants * 
    45    USE phycst             
    46  
    47    !* 1D configuration 
    48    USE c1d                                          
    49  
    50    !* model domain * 
    51    USE dom_oce  
     26   USE in_out_manager                           !* IO manager * 
     27   USE wrk_nemo                                 !* Memory Allocation * 
     28   USE timing                                   !* Timing *  
     29   USE lib_mpp                                  !* MPP library                          
     30   USE lib_fortran                              !* Fortran utilities                          
     31   USE lbclnk                                   !* Lateral boundary conditions                          
     32   USE phycst                                   !* physical constants * 
     33   USE c1d                                      !* 1D configuration 
     34   USE dom_oce                                  !* model domain * 
    5235 
    5336   USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport 
    … …  
    6649   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    6750   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    68 #if defined key_offline 
    69    USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
    70 #endif 
    7151   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    7252   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
    … …  
    7656   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
    7757   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    78    USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
     58#if defined key_offline 
     59   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
     60#endif 
    7961 
    8062   !* surface fluxes * 
    … …  
    10284   USE trc_oce 
    10385 
     86!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 
     87!!gm   so the following lines should be removed....   logical should be the one of TRC namelist 
     88!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 
    10489   !* lateral diffusivity (tracers) * 
    105    USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity 
    106    USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s) 
    107    USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s) 
    108    USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s) 
    109    USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points  
    110    USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points  
    111    USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points  
    112    USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points 
    113    USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s)  
    114    USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)    
    115    USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s)  
    116    USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
    117    USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
     90   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s] 
     91   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s] 
     92   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points  
     93   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points  
     94   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s)  
     95   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)    
     96   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s)  
     97   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag 
     98      
     99!!gm this should be : ln_trcldf_triad (TRC namelist) 
     100   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.) 
     101 
     102   !* direction of lateral diffusion * 
     103   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag 
     104   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point 
     105   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point 
     106   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point 
     107   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point 
     108!!gm end  
    118109 
    119110   !* vertical diffusion * 
    … …  
    128119   USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m) 
    129120   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
    130  
    131    !* direction of lateral diffusion * 
    132    USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag 
    133 # if   defined key_ldfslp 
    134    USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points 
    135    USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points 
    136    USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points 
    137    USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points 
    138 # endif 
    139121 
    140122   USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r5385 r5758  
    143143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
    144144# endif 
    145 #if defined key_ldfslp 
    146    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
    147    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
    150 #endif 
    151145#if defined key_trabbl 
    152146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
    … …  
    183177#endif 
    184178   ! 
    185 #if defined key_ldfslp 
    186    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
    187 #endif 
    188    !  
    189179# if defined key_zdfddm 
    190180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5407 r5758  
    146146  
    147147      tra(:,:,:,:) = 0._wp 
    148       IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive 
    149         &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient 
    150       IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    151         &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    152  
     148 
     149!!gm  case not.lk_c1d   is useless since in 1D, 9 identical column all resulting arrays are zero 
     150!!                       it is at the initialization so not a issue      
     151!      IF(.NOT. lk_c1d ) THEN 
     152!!gm 
     153      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( nit000, jptra, trn, gtru, gtrv, gtrui, gtrvi )  ! both top & bottom 
     154      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv )                ! only bottom  
     155      ENDIF 
     156!!gm       
     157!      ENDIF 
     158!!gm 
     159 
     160!!gm  ===>>>>>>  Anyyway, I don't understand why a call to zps_hde is needed here ! 
    153161 
    154162      ! 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r5656 r5758  
    4242   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    44  
    4544CONTAINS 
    46  
    4745 
    4846   SUBROUTINE trc_nam 
    … …  
    5755      !!--------------------------------------------------------------------- 
    5856      INTEGER  ::   jn                  ! dummy loop indice 
    59       !                                        !   Parameters of the run  
    60       IF( .NOT. lk_offline ) CALL trc_nam_run 
    61        
    62       !                                        !  passive tracer informations 
    63       CALL trc_nam_trc 
    64        
    65       !                                        !   Parameters of additional diagnostics 
    66       CALL trc_nam_dia 
    67  
    68       !                                        !   namelist of transport 
    69       CALL trc_nam_trp 
    70  
    71  
    72       IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
    73       ! 
    74       IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    75       ! 
    76       IF( .NOT.ln_trcdta ) THEN 
    77          ln_trc_ini(:) = .FALSE. 
    78       ENDIF 
    79  
    80      IF(lwp) THEN                   ! control print 
     57      !                                   
     58      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run  
     59      !                
     60                              CALL trc_nam_trc     ! passive tracer informations 
     61      !                                         
     62                              CALL trc_nam_dia     ! Parameters of additional diagnostics 
     63      !                                       
     64                              CALL trc_nam_trp     ! namelist of transport 
     65      ! 
     66      ! 
     67      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
     68      ! 
     69      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
     70      ! 
     71      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE. 
     72 
     73      IF(lwp) THEN                   ! control print 
    8174         WRITE(numout,*) 
    8275         WRITE(numout,*) ' Namelist : namtrc' 
    … …  
    149142      ! Call the ice module for tracers 
    150143      ! ------------------------------- 
    151       CALL trc_nam_ice 
     144                                  CALL trc_nam_ice 
    152145 
    153146      ! namelist of SMS 
    … …  
    171164   END SUBROUTINE trc_nam 
    172165 
     166 
    173167   SUBROUTINE trc_nam_run 
    174168      !!--------------------------------------------------------------------- 
    … …  
    180174      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    181175        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    182  
    183  
     176      ! 
    184177      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    185  
    186       !!--------------------------------------------------------------------- 
    187  
    188  
     178      !!--------------------------------------------------------------------- 
     179      ! 
    189180      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    190181      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    … …  
    220211    END SUBROUTINE trc_nam_run 
    221212 
     213 
    222214   SUBROUTINE trc_nam_ice 
    223215      !!--------------------------------------------------------------------- 
    … …  
    229221      !! 
    230222      !!--------------------------------------------------------------------- 
    231       ! --- Variable declarations --- ! 
    232223      INTEGER :: jn      ! dummy loop indices 
    233224      INTEGER :: ios     ! Local integer output status for namelist read 
    234  
    235       ! --- Namelist declarations --- ! 
     225      ! 
    236226      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     227      !! 
    237228      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    238  
     229      !!--------------------------------------------------------------------- 
     230      ! 
    239231      IF(lwp) THEN 
    240232         WRITE(numout,*) 
    … …  
    271263   END SUBROUTINE trc_nam_ice 
    272264 
     265 
    273266   SUBROUTINE trc_nam_trc 
    274267      !!--------------------------------------------------------------------- 
    … …  
    278271      !! 
    279272      !!--------------------------------------------------------------------- 
    280       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    281       !! 
    282       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    283    
    284273      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    285274      INTEGER  ::   jn                  ! dummy loop indice 
     275      ! 
     276      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     277      !! 
     278      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    286279      !!--------------------------------------------------------------------- 
    287280      IF(lwp) WRITE(numout,*) 
    288281      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    289282      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    290  
    291283 
    292284      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    … …  
    306298         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307299      END DO 
    308        
    309     END SUBROUTINE trc_nam_trc 
     300      ! 
     301   END SUBROUTINE trc_nam_trc 
    310302 
    311303 
    … …  
    320312      !!                ( (PISCES, CFC, MY_TRC ) 
    321313      !!--------------------------------------------------------------------- 
     314      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    322315      INTEGER ::  ierr 
     316      !! 
    323317#if defined key_trdmxl_trc  || defined key_trdtrc 
    324318      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    … …  
    327321#endif 
    328322      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    329  
    330       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    331323      !!--------------------------------------------------------------------- 
    332324 

  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r5215 r5758  
    4444   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)  
    4545 
     46   !                                                       !* iso-neutral slopes (if l_ldfslp=T) 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values  
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean  
     49 
    4650   !!* Substitution 
    4751#  include "top_substitute.h90" 
    … …  
    9397          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    9498# endif 
    95 #if defined key_ldfslp 
    96           wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
    97           wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
    98           uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
    99           vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    100 #endif 
     99         IF( l_ldfslp ) THEN 
     100            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:) 
     101            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:) 
     102            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
     103            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
     104         ENDIF 
    101105# if defined key_trabbl 
    102106          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    131135         avs_temp   (:,:,:)      = avs   (:,:,:) 
    132136# endif 
    133 #if defined key_ldfslp 
    134          wslpi_temp (:,:,:)      = wslpi (:,:,:) 
    135          wslpj_temp (:,:,:)      = wslpj (:,:,:) 
    136          uslp_temp  (:,:,:)      = uslp  (:,:,:) 
    137          vslp_temp  (:,:,:)      = vslp  (:,:,:) 
    138 #endif 
     137         IF( l_ldfslp ) THEN 
     138            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:) 
     139            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:) 
     140         ENDIF 
    139141# if defined key_trabbl 
    140142          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    175177         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    176178# endif 
    177 #if defined key_ldfslp 
    178          wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
    179          wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
    180          uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)  
    181          vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    182 #endif 
     179         IF( l_ldfslp ) THEN 
     180            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:)  
     181            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:) 
     182            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
     183            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
     184         ENDIF 
    183185# if defined key_trabbl 
    184186          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    255257                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t 
    256258                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t 
     259!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    257260                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w 
    258261# if defined key_zdfddm 
    259262                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w 
    260263# endif 
    261 #if defined key_ldfslp 
    262                   wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk)  
    263                   wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk) 
    264                   uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk) 
    265                   vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk) 
    266 #endif 
    267                ENDDO 
    268             ENDDO 
    269          ENDDO 
     264               END DO 
     265            END DO 
     266         END DO 
     267         IF( l_ldfslp ) THEN 
     268            wslpi(:,:,:)        = wslpi_tm(:,:,:)  
     269            wslpj(:,:,:)        = wslpj_tm(:,:,:) 
     270            uslp (:,:,:)        = uslp_tm (:,:,:) 
     271            vslp (:,:,:)        = vslp_tm (:,:,:) 
     272         ENDIF 
    270273         ! 
    271274         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity 
    … …  
    276279      ! 
    277280   END SUBROUTINE trc_sub_stp 
     281 
    278282 
    279283   SUBROUTINE trc_sub_ini 
    … …  
    304308      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    305309      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
     310!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    306311      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    307312# if defined key_zdfddm 
    308313      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    309314# endif 
    310 #if defined key_ldfslp 
    311       wslpi_tm(:,:,:)        = wslpi(:,:,:) 
    312       wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    313       uslp_tm (:,:,:)        = uslp (:,:,:) 
    314       vslp_tm (:,:,:)        = vslp (:,:,:) 
    315 #endif 
     315      IF( l_ldfslp ) THEN 
     316         wslpi_tm(:,:,:)     = wslpi(:,:,:) 
     317         wslpj_tm(:,:,:)     = wslpj(:,:,:) 
     318         uslp_tm (:,:,:)     = uslp (:,:,:) 
     319         vslp_tm (:,:,:)     = vslp (:,:,:) 
     320      ENDIF 
    316321      sshn_tm  (:,:) = sshn  (:,:)  
    317322      rnf_tm   (:,:) = rnf   (:,:)  
    … …  
    365370      avs   (:,:,:)   =  avs_temp   (:,:,:) 
    366371# endif 
    367 #if defined key_ldfslp 
    368       wslpi (:,:,:)   =  wslpi_temp (:,:,:) 
    369       wslpj (:,:,:)   =  wslpj_temp (:,:,:) 
    370       uslp  (:,:,:)   =  uslp_temp  (:,:,:) 
    371       vslp  (:,:,:)   =  vslp_temp  (:,:,:) 
    372 #endif 
     372      IF( l_ldfslp ) THEN 
     373         wslpi (:,:,:)=  wslpi_temp (:,:,:) 
     374         wslpj (:,:,:)=  wslpj_temp (:,:,:) 
     375         uslp  (:,:,:)=  uslp_temp  (:,:,:) 
     376         vslp  (:,:,:)=  vslp_temp  (:,:,:) 
     377      ENDIF 
    373378      sshn  (:,:)     =  sshn_temp  (:,:) 
    374379      sshb  (:,:)     =  sshb_temp  (:,:) 
    … …  
    411416         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    412417# endif 
    413 #if defined key_ldfslp 
     418      IF( l_ldfslp ) THEN 
     419         uslp_tm (:,:,:)        = uslp (:,:,:) 
     420         vslp_tm (:,:,:)        = vslp (:,:,:) 
    414421         wslpi_tm(:,:,:)        = wslpi(:,:,:)  
    415422         wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    416          uslp_tm (:,:,:)        = uslp (:,:,:) 
    417          vslp_tm (:,:,:)        = vslp (:,:,:) 
    418 #endif 
     423      ENDIF 
    419424      ! 
    420425      sshb_hold  (:,:) = sshn  (:,:) 
    … …  
    551556         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      & 
    552557         &      ssha_temp(jpi,jpj)          ,                           & 
    553 #if defined key_ldfslp 
    554          &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  & 
    555          &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   & 
    556 #endif 
    557558#if defined key_trabbl 
    558559         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    & 
    … …  
    577578         &      emp_b_hold(jpi,jpj)         ,                            & 
    578579         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         & 
    579 #if defined key_ldfslp 
    580          &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    & 
    581          &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     & 
    582 #endif 
    583580#if defined key_trabbl 
    584581         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      & 
    585582         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      & 
    586583#endif 
    587          &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       & 
    588          &                                    STAT=trc_sub_alloc )   
     584         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )   
     585      ! 
    589586      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 
    590  
     587      ! 
     588      IF( l_ldfslp ) THEN 
     589         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      & 
     590            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      & 
     591            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      & 
     592            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc ) 
     593      ENDIF 
     594      ! 
     595      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 
    591596      ! 
    592597   END FUNCTION trc_sub_alloc 
Note: See TracChangeset for help on using the changeset viewer.