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 8055 for branches/2017/wrk_OMP_test_for_Silvia/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90 – NEMO

Ignore:
Timestamp:
2017-05-20T13:49:38+02:00 (7 years ago)
Author:
gm
Message:

wrk_OMP: 2nd step: add OMP processor distribution in ZDF package

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/wrk_OMP_test_for_Silvia/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90

    r7990 r8055  
    1111   !!   zdf_phy       : upadate at each time-step the vertical mixing coeff.  
    1212   !!---------------------------------------------------------------------- 
    13    USE par_oce        ! ocean parameters 
     13   USE oce            ! ocean dynamics and tracers variables 
    1414   USE zdf_oce        ! vertical physics: shared variables          
    1515   USE zdfbfr         ! vertical physics: bottom friction 
    16    USE zdfric         ! vertical physics: Richardson vertical mixing    
     16   USE zdfsh2         ! vertical physics: shear production term of TKE 
     17   USE zdfric         ! vertical physics: RIChardson dependent vertical mixing    
    1718   USE zdftke         ! vertical physics: TKE vertical mixing 
    1819   USE zdfgls         ! vertical physics: GLS vertical mixing 
     
    4445   INTEGER, PARAMETER ::   np_TKE = 3   ! Turbulente Kinetic Eenergy closure scheme for Kz 
    4546   INTEGER, PARAMETER ::   np_GLS = 4   ! Generic Length Scale closure scheme for Kz 
    46        
     47 
     48   LOGICAL ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
     49 
     50   !! * Substitutions 
     51#  include "domain_substitute.h90"    
    4752   !!---------------------------------------------------------------------- 
    4853   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
     
    6166      !!                set horizontal shape and vertical profile of background mixing coef. 
    6267      !!---------------------------------------------------------------------- 
     68      INTEGER ::   jk            ! dummy loop indices 
    6369      INTEGER ::   ioptio, ios   ! local integers 
    6470      !! 
     
    9096         WRITE(numout,*) '      vertical closure scheme' 
    9197         WRITE(numout,*) '         constant vertical mixing coefficient    ln_zdfcst = ', ln_zdfcst 
    92          WRITE(numout,*) '         constant vertical mixing coefficient    ln_zdfric = ', ln_zdfric 
    93          WRITE(numout,*) '         constant vertical mixing coefficient    ln_zdftke = ', ln_zdftke 
    94          WRITE(numout,*) '         constant vertical mixing coefficient    ln_zdfgls = ', ln_zdfgls 
     98         WRITE(numout,*) '         Richardson number dependent closure     ln_zdfric = ', ln_zdfric 
     99         WRITE(numout,*) '         Turbulent Kinetic Energy closure (TKE)  ln_zdftke = ', ln_zdftke 
     100         WRITE(numout,*) '         Generic Length Scale closure (GLS)      ln_zdfgls = ', ln_zdfgls 
    95101         WRITE(numout,*) '      convection: ' 
    96102         WRITE(numout,*) '         enhanced vertical diffusion             ln_zdfevd = ', ln_zdfevd 
     
    137143      ENDIF 
    138144      ! 
    139       !                                   ! set 1st/last level Av to zero one for all 
    140       avt(:,:,1) = 0._wp   ;   avs(:,:,1) = 0._wp   ;   avm(:,:,1) = 0._wp 
     145      DO jk = 1, jpk                      ! set turbulent closure Kz to the background value (avt_k, avm_k) 
     146         avt_k(:,:,jk) = avtb_2d(:,:) * avtb(jk) * wmask (:,:,jk) 
     147         avm_k(:,:,jk) =                avmb(jk) * wmask (:,:,jk) 
     148      END DO 
     149!!gm  to be tested only the 1st & last levels 
     150!      avt  (:,:, 1 ) = 0._wp   ;   avs(:,:, 1 ) = 0._wp   ;   avm  (:,:, 1 ) = 0._wp 
     151!      avt  (:,:,jpk) = 0._wp   ;   avs(:,:,jpk) = 0._wp   ;   avm  (:,:,jpk) = 0._wp 
     152!!gm 
     153      avt  (:,:,:) = 0._wp   ;   avs(:,:,:) = 0._wp   ;   avm  (:,:,:) = 0._wp 
    141154 
    142155      !                          !==  Convection  ==! 
     
    170183      IF( ln_zdfric .OR. ln_zdfgls )    CALL ctl_stop( 'zdf_phy_init: zdfric and zdfgls never tested with ice shelves cavities ' ) 
    171184      ENDIF 
     185      !                                ! shear production term flag 
     186      IF( ln_zdfcst ) THEN   ;   l_zdfsh2 = .FALSE. 
     187      ELSE                   ;   l_zdfsh2 = .TRUE. 
     188      ENDIF 
    172189 
    173190      !                          !== gravity wave-driven mixing  ==! 
     
    200217      ! 
    201218      INTEGER ::   ji, jj, jk   ! dummy loop indice 
     219!!OMP      REAL(wp), DIMENSION(WRK_3D) ::   zsh2   ! shear production 
     220      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zsh2   ! shear production 
    202221      !! --------------------------------------------------------------------- 
     222      !       
     223!!OMP ===>>>>   Open-MP   to be defined elsewhere    
     224      ! 
     225      INTEGER ::   ARG_2D 
     226      ! 
     227#if defined key_vectopt_loop 
     228      k_Istr = 1   ;   k_Iend = jpi 
     229#else 
     230      k_Istr = 2   ;   k_Iend = jpim1 
     231#endif 
     232      k_Jstr = 2   ;   k_Jend = jpjm1 
     233      ! 
     234!!OMP <<<<===   end 
     235       
     236      ALLOCATE( zsh2(WRK_3D) ) 
     237       
     238       
    203239      ! 
    204240      CALL zdf_bfr( kt )                        !* bottom friction (if quadratic) 
    205       !                        
     241      ! 
     242 
     243      !                          !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
     244       
     245      IF( l_zdfsh2 )   &                        !* shear production at w-points (energy conserving form) 
     246         CALL zdf_sh2( ARG_2D, ub, vb, un, vn, avm_k,   &   ! <<== in  fields 
     247            &                                   zsh2    )   ! ==>> out field  : shear production 
     248 
     249      ! 
    206250      SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
    207       CASE( np_RIC )   ;   CALL zdf_ric( kt )         ! Richardson number dependent Kz 
    208       CASE( np_TKE )   ;   CALL zdf_tke( kt )         ! TKE closure scheme for Kz 
    209       CASE( np_GLS )   ;   CALL zdf_gls( kt )         ! GLS closure scheme for Kz 
     251      CASE( np_RIC )   ;   CALL zdf_ric( ARG_2D, kt, gdept_n, zsh2, avm_k, avt_k )         ! Richardson number dependent Kz 
     252      CASE( np_TKE )   ;   CALL zdf_tke( ARG_2D, kt         , zsh2, avm_k, avt_k )         ! TKE closure scheme for Kz 
     253      CASE( np_GLS )   ;   CALL zdf_gls( ARG_2D, kt         , zsh2, avm_k, avt_k )         ! GLS closure scheme for Kz 
    210254      CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    211          avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    212          avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
     255         ! avt_k and avm_k set one for all at initialisation phase 
     256!!gm         avt_k(WRK_3D) = rn_avt0 * wmask(WRK_3D) 
     257!!gm         avm_k(WRK_3D) = rn_avm0 * wmask(WRK_3D) 
    213258      END SELECT 
     259      !   
     260      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
     261      ! 
     262      !                                         !* start from turbulent closure values 
     263      avt(WRK_2D,2:jpkm1) = avt_k(WRK_2D,2:jpkm1) 
     264      avm(WRK_2D,2:jpkm1) = avm_k(WRK_2D,2:jpkm1) 
    214265      ! 
    215266      IF( ln_rnf_mouth ) THEN                   !* increase diffusivity at rivers mouths 
    216267         DO jk = 2, nkrnf 
    217             avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * wmask(:,:,jk) 
     268            avt(WRK_2D,jk) = avt(WRK_2D,jk) + 2._wp * rn_avt_rnf * rnfmsk(WRK_2D) * wmask(WRK_2D,jk) 
    218269         END DO 
    219270      ENDIF 
    220271      ! 
    221       IF( ln_zdfevd )   CALL zdf_evd( kt )      !* convection: enhanced vertical eddy diffusivity 
     272      IF( ln_zdfevd )   CALL zdf_evd( ARG_2D, kt, avm, avt )      !* convection: enhanced vertical eddy diffusivity 
    222273      ! 
    223274      !                                         !* double diffusive mixing 
    224275      IF( ln_zdfddm ) THEN                            ! update avt and compute avs 
    225                         CALL zdf_ddm( kt ) 
     276                        CALL zdf_ddm( ARG_2D, kt, avm, avt, avs ) 
    226277      ELSE                                            ! same mixing on all tracers 
    227          avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1) 
     278         avs(WRK_3D) = avt(WRK_3D) 
    228279      ENDIF 
    229280      ! 
    230281      !                                         !* wave-induced mixing  
    231       IF( ln_zdfswm )   CALL zdf_swm( kt )            ! surface  wave (Qiao et al. 2004)  
    232       IF( ln_zdfiwm )   CALL zdf_iwm( kt )            ! internal wave (de Lavergne et al 2017) 
     282      IF( ln_zdfswm )   CALL zdf_swm( ARG_2D, kt, avm, avt, avs )   ! surface  wave (Qiao et al. 2004)  
     283      IF( ln_zdfiwm )   CALL zdf_iwm( ARG_2D, kt, avm, avt, avs )   ! internal wave (de Lavergne et al 2017) 
    233284 
    234285 
    235286      !                                         !* Lateral boundary conditions (sign unchanged) 
    236       CALL lbc_lnk( avm, 'W', 1. ) 
    237       CALL lbc_lnk( avt, 'W', 1. ) 
    238       CALL lbc_lnk( avs, 'W', 1. ) 
    239       ! 
    240 !!gm  ===>>>   TO BE REMOVED  
    241       DO jk = 1, jpkm1            !* vertical eddy viscosity at wu- and wv-points 
    242          DO jj = 2, jpjm1 
    243             DO ji = 2, jpim1 
    244                avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * wumask(ji,jj,jk) 
    245                avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk) 
    246             END DO 
    247          END DO 
    248       END DO 
    249       CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions 
    250 !!gm end 
    251  
     287      CALL lbc_lnk( avm_k, 'W', 1. ) 
     288      CALL lbc_lnk( avt_k, 'W', 1. ) 
     289      CALL lbc_lnk( avm  , 'W', 1. ) 
     290      CALL lbc_lnk( avt  , 'W', 1. )                  !!gm  a priori only avm_k and avm are required 
     291      CALL lbc_lnk( avs  , 'W', 1. )                  !!gm  To be tested 
     292      ! 
    252293 
    253294      CALL zdf_mxl( kt )                        !* mixed layer depth, and level 
    254295 
    255 !!gm  !==>> to be moved in zdftke & zdfgls     
    256                                                       ! write TKE or GLS information in the restart file 
    257       IF( lrst_oce .AND. ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    258       IF( lrst_oce .AND. ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    259       !       
     296 
     297      IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
     298         IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
     299         IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
     300         IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )  
     301      ENDIF 
     302      ! 
     303      DEALLOCATE( zsh2 ) 
     304      ! 
    260305   END SUBROUTINE zdf_phy 
    261306 
Note: See TracChangeset for help on using the changeset viewer.