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 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90 – NEMO

Ignore:
Timestamp:
2017-12-01T18:44:09+01:00 (6 years ago)
Author:
flavoni
Message:

dev_CNRS_2017 branch: merged dev_r7881_ENHANCE09_RK3 with trunk r8864

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r7753 r8882  
    88   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module 
    99   !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after 
     10   !!            4.0  !  2017-04  (G. Madec)  evd applied on avm (at t-point)  
    1011   !!---------------------------------------------------------------------- 
    1112 
     
    2324   USE iom             ! for iom_put 
    2425   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE wrk_nemo        ! work arrays 
    2626   USE timing          ! Timing 
    2727 
     
    3838CONTAINS 
    3939 
    40    SUBROUTINE zdf_evd( kt ) 
     40   SUBROUTINE zdf_evd( kt, p_avm, p_avt ) 
    4141      !!---------------------------------------------------------------------- 
    4242      !!                  ***  ROUTINE zdf_evd  *** 
     
    4545      !!      sivity coefficients when a static instability is encountered. 
    4646      !! 
    47       !! ** Method  :   avt, avm, and the 4 neighbouring avmu, avmv coefficients 
    48       !!      are set to avevd (namelist parameter) if the water column is  
    49       !!      statically unstable (i.e. if rn2 < -1.e-12 ) 
     47      !! ** Method  :   tracer (and momentum if nn_evdm=1) vertical mixing  
     48      !!              coefficients are set to rn_evd (namelist parameter)  
     49      !!              if the water column is statically unstable. 
     50      !!                The test of static instability is performed using 
     51      !!              Brunt-Vaisala frequency (rn2 < -1.e-12) of to successive 
     52      !!              time-step (Leap-Frog environnement): before and 
     53      !!              now time-step. 
    5054      !! 
    51       !! ** Action  :   avt, avm, avmu, avmv updted in static instability cases 
    52       !! 
    53       !! References :   Lazar, A., these de l'universite Paris VI, France, 1997 
     55      !! ** Action  :   avt, avm   enhanced where static instability occurs 
    5456      !!---------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step 
     57      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time-step indexocean time step 
     58      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    5659      ! 
    5760      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    58       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_evd, zavm_evd 
    5962      !!---------------------------------------------------------------------- 
    6063      ! 
    61       IF( nn_timing == 1 )  CALL timing_start('zdf_evd') 
     64      IF( ln_timing )   CALL timing_start('zdf_evd') 
    6265      ! 
    6366      IF( kt == nit000 ) THEN 
     
    6871      ENDIF 
    6972      ! 
    70       CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )  
    7173      ! 
    72       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application 
     74      zavt_evd(:,:,:) = p_avt(:,:,:)         ! set avt prior to evd application 
    7375      ! 
    7476      SELECT CASE ( nn_evdm ) 
    7577      ! 
    76       CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 
     78      CASE ( 1 )           !==  enhance tracer & momentum Kz  ==!  (if rn2<-1.e-12) 
    7779         ! 
    78          zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
     80         zavm_evd(:,:,:) = p_avm(:,:,:)      ! set avm prior to evd application 
     81         ! 
     82!! change last digits results 
     83!         WHERE( MAX( rn2(2:jpi,2:jpj,2:jpkm1), rn2b(2:jpi,2:jpj,2:jpkm1) )  <= -1.e-12 ) THEN 
     84!            p_avt(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1) 
     85!            p_avm(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1) 
     86!         END WHERE 
    7987         ! 
    8088         DO jk = 1, jpkm1  
    81             DO jj = 2, jpj             ! no vector opt. 
    82                DO ji = 2, jpi 
     89            DO jj = 2, jpjm1 
     90               DO ji = 2, jpim1 
    8391                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    84                      avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    85                      avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    86                      avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk) 
    87                      avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk) 
    88                      avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk) 
    89                      avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk) 
     92                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     93                     p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    9094                  ENDIF 
    9195               END DO 
    9296            END DO 
    9397         END DO  
    94          CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions 
    95          CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    9698         ! 
    97          zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
    98          CALL iom_put( "avm_evd", zavm_evd )              ! output this change 
     99         zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
     100         CALL iom_put( "avm_evd", zavm_evd )                ! output this change 
    99101         ! 
    100       CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)  
     102      CASE DEFAULT         !==  enhance tracer Kz  ==!   (if rn2<-1.e-12)  
     103!! change last digits results 
     104!         WHERE( MAX( rn2(2:jpi,2:jpj,2:jpkm1), rn2b(2:jpi,2:jpj,2:jpkm1) )  <= -1.e-12 ) 
     105!            p_avt(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1) 
     106!         END WHERE 
     107 
    101108         DO jk = 1, jpkm1 
    102 !!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
    103             DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call) 
    104                DO ji = 1, jpi 
     109            DO jj = 2, jpjm1 
     110               DO ji = 2, jpim1 
    105111                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    106                      avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk) 
     112                     p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    107113               END DO 
    108114            END DO 
     
    110116         ! 
    111117      END SELECT  
    112  
    113       zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
     118      ! 
     119      zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    114120      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
    115121      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    116122      ! 
    117       CALL wrk_dealloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )  
    118       ! 
    119       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd') 
     123      IF( ln_timing )   CALL timing_stop('zdf_evd') 
    120124      ! 
    121125   END SUBROUTINE zdf_evd 
Note: See TracChangeset for help on using the changeset viewer.