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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4624 r6225  
    66   !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing 
    77   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    8    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_zdfddm   ||   defined key_esopa 
     8   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     9   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 
     10   !!---------------------------------------------------------------------- 
     11#if defined key_zdfddm 
    1112   !!---------------------------------------------------------------------- 
    1213   !!   'key_zdfddm' :                                     double diffusion 
     
    1819   USE dom_oce         ! ocean space and time domain variables  
    1920   USE zdf_oce         ! ocean vertical physics variables 
     21   USE eosbn2         ! equation of state 
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    3437   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag 
    3538 
    36    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs    !: salinity vertical diffusivity coeff. at w-point 
    37    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   rrau   !: heat/salt buoyancy flux ratio 
    38  
    39    !                      !!* Namelist namzdf_ddm : double diffusive mixing * 
    40    REAL(wp) ::   rn_avts   ! maximum value of avs for salt fingering 
    41    REAL(wp) ::   rn_hsbfr  ! heat/salt buoyancy flux ratio 
     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 
    4244 
    4345   !! * Substitutions 
    4446#  include "vectopt_loop_substitute.h90" 
    4547   !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     48   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4749   !! $Id$ 
    4850   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    5456      !!                ***  ROUTINE zdf_ddm_alloc  *** 
    5557      !!---------------------------------------------------------------------- 
    56       ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT= zdf_ddm_alloc ) 
    57       ! 
     58      ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc ) 
    5859      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc ) 
    5960      IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') 
     
    7172      !!      diffusive mixing (i.e. salt fingering and diffusive layering) 
    7273      !!      following Merryfield et al. (1999). The rate of double diffusive  
    73       !!      mixing depend on the buoyancy ratio: Rrau=alpha/beta dk[T]/dk[S] 
    74       !!      which is computed in rn2.F 
     74      !!      mixing depend on the buoyancy ratio (R=alpha/beta dk[T]/dk[S]): 
    7575      !!         * salt fingering (Schmitt 1981): 
    76       !!      for Rrau > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (Rrau/rn_hsbfr)^6 ) 
    77       !!      for Rrau > 1 and rn2 > 0 : zavfs = O 
    78       !!      otherwise                : zavft = 0.7 zavs / Rrau 
     76      !!      for R > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (R/rn_hsbfr)^6 ) 
     77      !!      for R > 1 and rn2 > 0 : zavfs = O 
     78      !!      otherwise                : zavft = 0.7 zavs / R 
    7979      !!         * diffusive layering (Federov 1988): 
    80       !!      for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6   
    81       !!                                 * exp( 4.6 exp(-0.54 (1/Rrau-1) ) ) 
     80      !!      for 0< R < 1 and N^2 > 0 : zavdt = 1.3635e-6 * exp( 4.6 exp(-0.54 (1/R-1) ) ) 
    8281      !!      otherwise                   : zavdt = 0  
    83       !!      for .5 < Rrau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau -0.85) 
    84       !!      for  0 < Rrau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau       
     82      !!      for .5 < R < 1 and N^2 > 0 : zavds = zavdt (1.885 R -0.85) 
     83      !!      for  0 < R <.5 and N^2 > 0 : zavds = zavdt 0.15 R       
    8584      !!      otherwise                     : zavds = 0  
    8685      !!         * update the eddy diffusivity: 
     
    9695      ! 
    9796      INTEGER  ::   ji, jj , jk     ! dummy loop indices 
    98       REAL(wp) ::   zinr, zrr       ! temporary scalars 
    99       REAL(wp) ::   zavft, zavfs    !    -         - 
    100       REAL(wp) ::   zavdt, zavds    !    -         - 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     97      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     98      REAL(wp) ::   zdt, zds 
     99      REAL(wp) ::   zinr, zrr       !   -      - 
     100      REAL(wp) ::   zavft, zavfs    !   -      - 
     101      REAL(wp) ::   zavdt, zavds    !   -      - 
     102      REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    102103      !!---------------------------------------------------------------------- 
    103104      ! 
    104105      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm') 
    105106      ! 
    106       CALL wrk_alloc( jpi,jpj, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
    107  
     107      CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
     108      ! 
    108109      !                                                ! =============== 
    109110      DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    111112         ! Define the mask  
    112113         ! --------------- 
    113          rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) )         ! only retains positive value of rrau 
     114         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
     115            DO ji = 1, jpi 
     116               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
     117                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )  
     118               ! 
     119               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  & 
     120                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     121               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  & 
     122                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     123               ! 
     124               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 
     125               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
     126               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
     127               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
     128            END DO 
     129         END DO 
    114130 
    115131         DO jj = 1, jpj                                     ! indicators: 
     
    119135               ELSE                                       ;   zmsks(ji,jj) = 1._wp 
    120136               ENDIF 
    121                ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere             
    122                IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0._wp 
     137               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
     138               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
    123139               ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    124140               ENDIF 
    125141               ! diffusive layering indicators:  
    126                !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere 
    127                IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     142               !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
     143               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
    128144               ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    129145               ENDIF 
    130                !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
    131                IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     146               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
     147               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
    132148               ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    133149               ENDIF 
    134                !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere 
    135                IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
    136                ELSE                                                         ;   zmskd3(ji,jj) = 1._wp 
     150               !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
     151               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     152               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
    137153               ENDIF 
    138154            END DO 
    139155         END DO 
    140156         ! mask zmsk in order to have avt and avs masked 
    141          zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk) 
     157         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
    142158 
    143159 
     
    145161         ! ------------------ 
    146162         ! Constant eddy coefficient: reset to the background value 
    147 !CDIR NOVERRCHK 
    148163         DO jj = 1, jpj 
    149 !CDIR NOVERRCHK 
    150164            DO ji = 1, jpi 
    151                zinr = 1./rrau(ji,jj,jk) 
     165               zinr = 1._wp / zrau(ji,jj) 
    152166               ! salt fingering 
    153                zrr = rrau(ji,jj,jk)/rn_hsbfr 
     167               zrr = zrau(ji,jj) / rn_hsbfr 
    154168               zrr = zrr * zrr 
    155169               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
     
    157171               ! diffusive layering 
    158172               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
    159                zavds = zavdt * zmsks(ji,jj) * (  (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   & 
    160                   &                            +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  ) 
     173               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
     174                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    161175               ! add to the eddy viscosity coef. previously computed 
    162176               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
     
    174188               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    & 
    175189                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   & 
    176                   &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * umask(ji,jj,jk) 
     190                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk) 
    177191               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    & 
    178192                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   & 
    179                   &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * vmask(ji,jj,jk) 
     193                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk) 
    180194            END DO 
    181195         END DO 
     
    196210      ENDIF 
    197211      ! 
    198       CALL wrk_dealloc( jpi,jpj, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
     212      CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
    199213      ! 
    200214      IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm') 
     
    212226      !!              called by zdf_ddm at the first timestep (nit000) 
    213227      !!---------------------------------------------------------------------- 
     228      INTEGER ::   ios   ! local integer 
     229      !! 
    214230      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    215       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    216231      !!---------------------------------------------------------------------- 
    217232      ! 
     
    237252      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 
    238253      !                               ! initialization to masked Kz 
    239       avs(:,:,:) = rn_avt0 * tmask(:,:,:)  
     254      avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
    240255      ! 
    241256   END SUBROUTINE zdf_ddm_init 
Note: See TracChangeset for help on using the changeset viewer.