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 8866 – NEMO

Changeset 8866


Ignore:
Timestamp:
2017-12-01T07:22:09+01:00 (7 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): Agrif: remove Agrif_update_tke + style cleaning

Location:
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r8863 r8866  
    44   !! AGRIF: interpolation package for the ocean dynamics (OPA) 
    55   !!====================================================================== 
    6    !! History :  2.0  !  2002-06  (XXX)  Original cade 
    7    !!             -   !  2005-11  (XXX)  
     6   !! History :  2.0  !  2002-06  (L. Debreu)  Original cade 
    87   !!            3.2  !  2009-04  (R. Benshila)  
    98   !!            3.6  !  2014-09  (R. Benshila)  
     
    1514   !!   Agrif_tra     : 
    1615   !!   Agrif_dyn     :  
     16   !!   Agrif_ssh     : 
     17   !!   Agrif_dyn_ts  : 
     18   !!   Agrif_dta_ts  : 
     19   !!   Agrif_ssh_ts  : 
     20   !!   Agrif_avm     :  
    1721   !!   interpu       : 
    1822   !!   interpv       : 
     
    3741   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    3842   PUBLIC   interpe3t, interpumsk, interpvmsk 
    39    PUBLIC   Agrif_tke, interpavm 
     43   PUBLIC   Agrif_avm, interpavm 
    4044 
    4145   INTEGER ::   bdy_tinterp = 0 
     
    595599 
    596600 
    597    SUBROUTINE Agrif_tke 
    598       !!---------------------------------------------------------------------- 
    599       !!                  ***  ROUTINE Agrif_tke  *** 
     601   SUBROUTINE Agrif_avm 
     602      !!---------------------------------------------------------------------- 
     603      !!                  ***  ROUTINE Agrif_avm  *** 
    600604      !!----------------------------------------------------------------------   
    601605      REAL(wp) ::   zalpha 
    602606      !!----------------------------------------------------------------------   
    603607      ! 
    604       zalpha = 1._wp ! JC: proper time interpolation impossible  
    605                      ! => use last available value from parent  
    606       ! 
    607       Agrif_SpecialValue    = 0.e0 
     608      zalpha = 1._wp   ! proper time interpolation impossible  ==> use last available value from parent  
     609      ! 
     610      Agrif_SpecialValue    = 0._wp 
    608611      Agrif_UseSpecialValue = .TRUE. 
    609612      ! 
    610       CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
     613      CALL Agrif_Bc_variable( avm_id, calledweight=zalpha, procname=interpavm )        
    611614      ! 
    612615      Agrif_UseSpecialValue = .FALSE. 
    613616      ! 
    614    END SUBROUTINE Agrif_tke 
     617   END SUBROUTINE Agrif_avm 
    615618    
    616619 
     
    630633      !!---------------------------------------------------------------------- 
    631634      ! 
    632       IF (before) THEN          
     635      IF( before ) THEN          
    633636         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
    634637      ELSE 
    635638         ! 
    636          western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
    637          southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     639         western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2) 
     640         southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2) 
    638641         ! 
    639642         IF( nbghostcells > 1 ) THEN  ! no smoothing 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r8586 r8866  
    77   !! AGRIF: update package for the ocean dynamics (OPA) 
    88   !!====================================================================== 
    9    !! History :  2.0  !  2002-06  (XXX)  Original cade 
    10    !!             -   !  2005-11  (XXX)  
     9   !! History :  2.0  !  2002-06  (L. Debreu)  Original code 
    1110   !!            3.2  !  2009-04  (R. Benshila)  
    1211   !!            3.6  !  2014-09  (R. Benshila)  
     
    2928 
    3029   PUBLIC   Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales 
    31    PUBLIC   Agrif_Update_Tke 
    3230 
    3331   !!---------------------------------------------------------------------- 
     
    160158   END SUBROUTINE Agrif_Update_Dyn 
    161159 
    162 !!gm Missing GLS case !!!!! 
    163  
    164    SUBROUTINE Agrif_Update_Tke( kt ) 
    165       !!---------------------------------------------------------------------- 
    166       !!                   *** ROUTINE Agrif_Update_Tke *** 
    167       !!---------------------------------------------------------------------- 
    168       INTEGER, INTENT(in) ::   kt   ! timestep index 
    169       !!---------------------------------------------------------------------- 
    170       ! 
    171 !!gm test on kt/=0  ????  why not nit000-1  ?  doesn't seem logic 
    172       IF( ( Agrif_NbStepint() /= 0 ) .AND. kt /= 0 )   RETURN 
    173 #  if defined TWO_WAY 
    174       ! 
    175       Agrif_UseSpecialValueInUpdate = .TRUE. 
    176       Agrif_SpecialValueFineGrid    = 0._wp 
    177       ! 
    178       CALL Agrif_Update_Variable(  en_id, locupdate=(/0,0/), procname=updateEN  ) 
    179       CALL Agrif_Update_Variable( avt_id, locupdate=(/0,0/), procname=updateAVT ) 
    180       CALL Agrif_Update_Variable( avm_id, locupdate=(/0,0/), procname=updateAVM ) 
    181       ! 
    182       Agrif_UseSpecialValueInUpdate = .FALSE. 
    183       ! 
    184 #  endif 
    185       ! 
    186    END SUBROUTINE Agrif_Update_Tke 
    187     
    188160 
    189161   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     
    215187                  DO jj = j1, j2 
    216188                     DO ji = i1, i2 
    217                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     189                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
    218190                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    219191                              &             + atfp * ( tabres(ji,jj,jk,jn) - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     
    228200               DO jj=j1,j2 
    229201                  DO ji=i1,i2 
    230                      IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
     202                     IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN  
    231203                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    232204                     END IF 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90

    r8863 r8866  
    2828   USE sbcrnf         ! surface boundary condition: runoff variables 
    2929#if defined key_agrif 
    30    USE agrif_opa_interp 
     30   USE agrif_opa_interp   ! interpavm 
    3131#endif 
    3232   ! 
     
    279279 
    280280#if defined key_agrif  
    281       ! interpolation parent grid => child grid for avm_k ( ex : at west border: 
    282       ! update column 1 and 2) 
    283       CALL Agrif_tke 
     281      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
     282      IF( l_zdfsh2 )   CALL Agrif_avm 
    284283#endif 
    285284 
    286285      !                                         !* Lateral boundary conditions (sign unchanged) 
    287       CALL lbc_lnk( avm_k, 'W', 1. )                  ! needed to compute the shear production term 
    288       CALL lbc_lnk( avt_k, 'W', 1. )                  !!gm a priori useless ==>> to be tested 
     286      IF( l_zdfsh2 ) THEN 
     287         CALL lbc_lnk( avm_k, 'W', 1. )               ! needed to compute the shear production term 
     288         CALL lbc_lnk( avt_k, 'W', 1. )               !!gm a priori useless ==>> to be tested 
     289      ENDIF 
    289290      CALL lbc_lnk( avm  , 'W', 1. )                  ! needed to compute avm at u- and v-points 
    290291      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      CALL lbc_lnk( avs  , 'W', 1. )                  !!gm  for calculation, keeped here for output only 
    292293      ! 
    293294      IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
     
    297298      ! 
    298299      CALL zdf_mxl( kt )                        !* mixed layer depth, and level 
    299  
     300      ! 
    300301      IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
    301302         IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r8863 r8866  
    4646   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    4747   USE zdfmxl         ! vertical physics: mixed layer 
    48 #if defined key_agrif 
    49    USE agrif_opa_interp 
    50    USE agrif_opa_update 
    51 #endif 
    5248   ! 
    5349   USE in_out_manager ! I/O manager 
     
    107103      !!---------------------------------------------------------------------- 
    108104      ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) ,   STAT= zdf_tke_alloc ) 
    109          ! 
     105      ! 
    110106      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    111107      IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 
     
    171167 
    172168 
    173    SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2    & 
    174       &                            , p_avm, p_avt ) 
     169   SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2, p_avm, p_avt ) 
    175170      !!---------------------------------------------------------------------- 
    176171      !!                   ***  ROUTINE tke_tke  *** 
     
    217212      zfact3 = 0.5_wp       * rn_ediss 
    218213      ! 
    219       ! 
    220214      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    221215      !                     !  Surface/top/bottom boundary condition on tke 
     
    234228         END DO 
    235229      ENDIF 
    236        
     230      ! 
    237231      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    238232      !                     !  Bottom boundary condition on tke 
     
    395389         END DO 
    396390      END DO 
    397  
     391      ! 
    398392      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    399393      !                            !  TKE due to surface and internal wave breaking 
     
    483477      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    484478      REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
    485       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld 
     479      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
    486480      !!-------------------------------------------------------------------- 
    487481      ! 
    488482      IF( ln_timing )   CALL timing_start('tke_avn') 
    489  
     483      ! 
    490484      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    491485      !                     !  Mixing length 
     
    597591      END SELECT 
    598592      ! 
    599  
    600593      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    601594      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
     
    623616         END DO 
    624617      ENDIF 
    625  
     618      ! 
    626619      IF(ln_ctl) THEN 
    627620         CALL prt_ctl( tab3d_1=en , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
Note: See TracChangeset for help on using the changeset viewer.