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/zdfddm.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/zdfddm.F90

    r7753 r8882  
    88   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    99   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 
     10   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
    1011   !!---------------------------------------------------------------------- 
    11 #if defined key_zdfddm 
     12 
    1213   !!---------------------------------------------------------------------- 
    13    !!   'key_zdfddm' :                                     double diffusion 
     14   !!   zdf_ddm       : compute the Kz for salinity 
    1415   !!---------------------------------------------------------------------- 
    15    !!   zdf_ddm       : compute the Ks for salinity 
    16    !!   zdf_ddm_init  : read namelist and control the parameters 
    17    !!---------------------------------------------------------------------- 
    18    USE oce             ! ocean dynamics and tracers variables 
    19    USE dom_oce         ! ocean space and time domain variables  
    20    USE zdf_oce         ! ocean vertical physics variables 
     16   USE oce            ! ocean dynamics and tracers variables 
     17   USE dom_oce        ! ocean space and time domain variables 
     18   USE zdf_oce        ! ocean vertical physics variables 
    2119   USE eosbn2         ! equation of state 
    2220   ! 
    23    USE in_out_manager  ! I/O manager 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE prtctl          ! Print control 
    26    USE lib_mpp         ! MPP library 
    27    USE wrk_nemo        ! work arrays 
    28    USE timing          ! Timing 
     21   USE in_out_manager ! I/O manager 
     22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     23   USE prtctl         ! Print control 
     24   USE lib_mpp        ! MPP library 
     25   USE timing         ! Timing 
    2926 
    3027   IMPLICIT NONE 
     
    3229 
    3330   PUBLIC   zdf_ddm       ! called by step.F90 
    34    PUBLIC   zdf_ddm_init  ! called by opa.F90 
    35    PUBLIC   zdf_ddm_alloc ! called by nemogcm.F90 
    36  
    37    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag 
    38  
    39    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs   !: salinity vertical diffusivity coeff. at w-point 
    40  
    41    !                       !!* Namelist namzdf_ddm : double diffusive mixing * 
    42    REAL(wp) ::   rn_avts    ! maximum value of avs for salt fingering 
    43    REAL(wp) ::   rn_hsbfr   ! heat/salt buoyancy flux ratio 
    4431 
    4532   !! * Substitutions 
     
    5239CONTAINS 
    5340 
    54    INTEGER FUNCTION zdf_ddm_alloc() 
    55       !!---------------------------------------------------------------------- 
    56       !!                ***  ROUTINE zdf_ddm_alloc  *** 
    57       !!---------------------------------------------------------------------- 
    58       ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc ) 
    59       IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc ) 
    60       IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') 
    61    END FUNCTION zdf_ddm_alloc 
    62  
    63  
    64    SUBROUTINE zdf_ddm( kt ) 
     41   SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs ) 
    6542      !!---------------------------------------------------------------------- 
    6643      !!                  ***  ROUTINE zdf_ddm  *** 
     
    8663      !!      avt = avt + zavft + zavdt 
    8764      !!      avs = avs + zavfs + zavds 
    88       !!      avmu, avmv are required to remain at least above avt and avs. 
     65      !!      avm is required to remain at least above avt and avs. 
    8966      !!       
    9067      !! ** Action  :   avt, avs : updated vertical eddy diffusivity coef. for T & S 
     
    9269      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999. 
    9370      !!---------------------------------------------------------------------- 
    94       INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step 
     71      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step indexocean time step 
     72      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm   !  Kz on momentum    (w-points) 
     73      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avt   !  Kz on temperature (w-points) 
     74      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_avs   !  Kz on salinity    (w-points) 
    9575      ! 
    9676      INTEGER  ::   ji, jj , jk     ! dummy loop indices 
     
    10080      REAL(wp) ::   zavft, zavfs    !   -      - 
    10181      REAL(wp) ::   zavdt, zavds    !   -      - 
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     82      REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    10383      !!---------------------------------------------------------------------- 
    10484      ! 
    105       IF( nn_timing == 1 )  CALL timing_start('zdf_ddm') 
    106       ! 
    107       CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
     85      IF( ln_timing )   CALL timing_start('zdf_ddm') 
    10886      ! 
    10987      !                                                ! =============== 
     
    11290         ! Define the mask  
    11391         ! --------------- 
    114          DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
     92!!gm  WORK to be done:   change the code from vector optimisation to scalar one. 
     93!!gm                     ==>>>  test in the loop instead of use of mask arrays 
     94!!gm                            and many acces in memory 
     95          
     96         DO jj = 1, jpj                !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    11597            DO ji = 1, jpi 
    11698               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     99!!gm please, use e3w_n below  
    117100                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )  
    118101               ! 
     
    129112         END DO 
    130113 
    131          DO jj = 1, jpj                                     ! indicators: 
     114         DO jj = 1, jpj                !==  indicators  ==! 
    132115            DO ji = 1, jpi 
    133116               ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
     
    174157                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    175158               ! add to the eddy viscosity coef. previously computed 
    176 # if defined key_zdftmx_new 
    177                ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx 
    178                avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds 
    179 # else 
    180                avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
    181 # endif 
    182                avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt 
    183                avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 
    184             END DO 
    185          END DO 
    186  
    187  
    188          ! Increase avmu, avmv if necessary 
    189          ! -------------------------------- 
    190 !!gm to be changed following the definition of avm. 
    191          DO jj = 1, jpjm1 
    192             DO ji = 1, fs_jpim1   ! vector opt. 
    193                avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    & 
    194                   &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   & 
    195                   &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk) 
    196                avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    & 
    197                   &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   & 
    198                   &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk) 
     159               p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 
     160               p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 
     161               p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 
    199162            END DO 
    200163         END DO 
     
    203166      !                                                   ! =============== 
    204167      ! 
    205       CALL lbc_lnk( avt , 'W', 1._wp )     ! Lateral boundary conditions   (unchanged sign) 
    206       CALL lbc_lnk( avs , 'W', 1._wp ) 
    207       CALL lbc_lnk( avm , 'W', 1._wp ) 
    208       CALL lbc_lnk( avmu, 'U', 1._wp )  
    209       CALL lbc_lnk( avmv, 'V', 1._wp ) 
    210  
    211168      IF(ln_ctl) THEN 
    212169         CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk) 
    213          CALL prt_ctl(tab3d_1=avmu, clinfo1=' ddm  - u: ', mask1=umask, & 
    214             &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk) 
    215170      ENDIF 
    216171      ! 
    217       CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
    218       ! 
    219       IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm') 
     172      IF( ln_timing )   CALL timing_stop('zdf_ddm') 
    220173      ! 
    221174   END SUBROUTINE zdf_ddm 
    222175    
    223     
    224    SUBROUTINE zdf_ddm_init 
    225       !!---------------------------------------------------------------------- 
    226       !!                  ***  ROUTINE zdf_ddm_init  *** 
    227       !! 
    228       !! ** Purpose :   Initialization of double diffusion mixing scheme 
    229       !! 
    230       !! ** Method  :   Read the namzdf_ddm namelist and check the parameter values 
    231       !!              called by zdf_ddm at the first timestep (nit000) 
    232       !!---------------------------------------------------------------------- 
    233       INTEGER ::   ios   ! local integer 
    234       !! 
    235       NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    236       !!---------------------------------------------------------------------- 
    237       ! 
    238       REWIND( numnam_ref )              ! Namelist namzdf_ddm in reference namelist : Double diffusion mixing scheme 
    239       READ  ( numnam_ref, namzdf_ddm, IOSTAT = ios, ERR = 901) 
    240 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in reference namelist', lwp ) 
    241  
    242       REWIND( numnam_cfg )              ! Namelist namzdf_ddm in configuration namelist : Double diffusion mixing scheme 
    243       READ  ( numnam_cfg, namzdf_ddm, IOSTAT = ios, ERR = 902 ) 
    244 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in configuration namelist', lwp ) 
    245       IF(lwm) WRITE ( numond, namzdf_ddm ) 
    246       ! 
    247       IF(lwp) THEN                    ! Parameter print 
    248          WRITE(numout,*) 
    249          WRITE(numout,*) 'zdf_ddm : double diffusive mixing' 
    250          WRITE(numout,*) '~~~~~~~' 
    251          WRITE(numout,*) '   Namelist namzdf_ddm : set dd mixing parameter' 
    252          WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts 
    253          WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr 
    254       ENDIF 
    255       ! 
    256       !                               ! allocate zdfddm arrays 
    257       IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 
    258       !                               ! initialization to masked Kz 
    259       avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
    260       ! 
    261    END SUBROUTINE zdf_ddm_init 
    262  
    263 #else 
    264    !!---------------------------------------------------------------------- 
    265    !!   Default option :          Dummy module          No double diffusion 
    266    !!---------------------------------------------------------------------- 
    267    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag 
    268 CONTAINS 
    269    SUBROUTINE zdf_ddm( kt )           ! Dummy routine 
    270       WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt 
    271    END SUBROUTINE zdf_ddm 
    272    SUBROUTINE zdf_ddm_init            ! Dummy routine 
    273    END SUBROUTINE zdf_ddm_init 
    274 #endif 
    275  
    276176   !!====================================================================== 
    277177END MODULE zdfddm 
Note: See TracChangeset for help on using the changeset viewer.