Changeset 5081


Ignore:
Timestamp:
2015-02-13T10:51:27+01:00 (6 years ago)
Author:
smasson
Message:

dev_r4765_CNRS_agrif: final version of tke/agrif?

Location:
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/CONFIG/SHARED/1_namelist_ref

    r4790 r5081  
    524524   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    525525   ln_chk_bathy  = .FALSE. ! 
    526    ln_agrif_tke  = .FALSE. 
    527526/ 
    528527!----------------------------------------------------------------------- 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r4984 r5081  
    2525   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2626   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry  
    27    LOGICAL , PUBLIC ::   ln_agrif_tke  = .FALSE.   !: interp/extrap for TKE 
    2827 
    2928   !                                              !!! OLD namelist names 
     
    6665   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 
    6766   INTEGER :: scales_t_id 
    68    INTEGER :: avt_id, avm_id, avmu_id, avmv_id 
     67# if defined key_zdftke 
     68   INTEGER :: avt_id, avm_id, en_id 
     69# endif   
    6970   INTEGER :: umsk_id, vmsk_id 
    7071   INTEGER :: kindic_agr 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r4984 r5081  
    4343   PUBLIC   interpe3t, interpumsk, interpvmsk 
    4444# if defined key_zdftke 
    45    PUBLIC   Agrif_tke, interpavt, interpavm, interpavmu, interpavmv 
     45   PUBLIC   Agrif_tke, interpavm 
    4646# endif 
    4747 
     
    609609      !!                  ***  ROUTINE Agrif_tke  *** 
    610610      !!----------------------------------------------------------------------   
    611       ! 
    612       IF( Agrif_Root() )   RETURN 
    613  
     611      REAL(wp) ::   zalpha 
     612      ! 
     613      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
     614      IF( zalpha > 1. )   zalpha = 1. 
    614615       
    615616      Agrif_SpecialValue    = 0.e0 
    616617      Agrif_UseSpecialValue = .TRUE. 
    617618       
    618       CALL Agrif_Bc_variable(avt_id , procname=interpavt)        
    619       CALL Agrif_Bc_variable(avm_id , procname=interpavm)        
    620       CALL Agrif_Bc_variable(avmu_id, procname=interpavmu) 
    621       CALL Agrif_Bc_variable(avmv_id, procname=interpavmv) 
     619      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
    622620               
    623621      Agrif_UseSpecialValue = .FALSE. 
     
    13211319 
    13221320# if defined key_zdftke 
    1323    SUBROUTINE interpavt(ptab,i1,i2,j1,j2,k1,k2,before) 
    1324       !!---------------------------------------------------------------------- 
    1325       !!                  ***  ROUTINE interavt  *** 
    1326       !!----------------------------------------------------------------------   
    1327       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1328       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab       
    1329       LOGICAL, INTENT(in) :: before 
    1330       !!----------------------------------------------------------------------   
    1331       !       
    1332       IF( before) THEN 
    1333          ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
    1334       ELSE 
    1335          avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
    1336       ENDIF 
    1337       ! 
    1338        
    1339    END SUBROUTINE interpavt 
    1340  
    13411321 
    13421322   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 
     
    13571337   END SUBROUTINE interpavm 
    13581338 
    1359  
    1360    SUBROUTINE interpavmu(ptab,i1,i2,j1,j2,k1,k2,before) 
    1361       !!---------------------------------------------------------------------- 
    1362       !!                  ***  ROUTINE interavmu  *** 
    1363       !!----------------------------------------------------------------------   
    1364       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1365       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1366       LOGICAL, INTENT(in) :: before 
    1367       !!----------------------------------------------------------------------   
    1368       ! 
    1369       IF( before) THEN 
    1370          ptab  (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2) 
    1371       ELSE 
    1372          avmu_k(i1:i2,j1:j2,k1:k2) = ptab   (i1:i2,j1:j2,k1:k2) 
    1373       ENDIF 
    1374       !       
    1375    END SUBROUTINE interpavmu 
    1376  
    1377  
    1378    SUBROUTINE interpavmv(ptab,i1,i2,j1,j2,k1,k2,before) 
    1379       !!---------------------------------------------------------------------- 
    1380       !!                  ***  ROUTINE interavmv  *** 
    1381       !!----------------------------------------------------------------------   
    1382       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1383       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1384       LOGICAL, INTENT(in) :: before 
    1385       !!----------------------------------------------------------------------   
    1386       ! 
    1387       IF( before) THEN 
    1388          ptab  (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2) 
    1389       ELSE 
    1390          avmv_k(i1:i2,j1:j2,k1:k2) = ptab  (i1:i2,j1:j2,k1:k2) 
    1391       ENDIF 
    1392       ! 
    1393    END SUBROUTINE interpavmv 
    13941339# endif /* key_zdftke */ 
    13951340 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r4980 r5081  
    160160      INTEGER, INTENT(in) :: kt 
    161161      !        
    162       IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
     162      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 
    163163#  if defined TWO_WAY 
    164164 
     
    166166      Agrif_SpecialValueFineGrid = 0. 
    167167 
    168       CALL Agrif_Update_Variable(avt_id ,locupdate=(/0,0/), procname=updateAVT ) 
    169       CALL Agrif_Update_Variable(avm_id ,locupdate=(/0,0/), procname=updateAVM ) 
    170       CALL Agrif_Update_Variable(avmu_id,locupdate=(/0,0/), procname=updateAVMu) 
    171       CALL Agrif_Update_Variable(avmv_id,locupdate=(/0,0/), procname=updateAVMv) 
     168      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  ) 
     169      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 
     170      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 
    172171 
    173172      Agrif_UseSpecialValueInUpdate = .FALSE. 
     
    601600 
    602601# if defined key_zdftke 
    603    SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 
    604       !!--------------------------------------------- 
    605       !!           *** ROUTINE updateavt *** 
     602   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
     603      !!--------------------------------------------- 
     604      !!           *** ROUTINE updateen *** 
    606605      !!--------------------------------------------- 
    607606      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     
    611610      ! 
    612611      IF (before) THEN 
    613          ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
    614       ELSE 
    615          avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    616       ENDIF 
    617       ! 
    618    END SUBROUTINE updateAVT 
    619  
    620  
    621    SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 
    622       !!--------------------------------------------- 
    623       !!           *** ROUTINE updateavm *** 
     612         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 
     613      ELSE 
     614         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     615      ENDIF 
     616      ! 
     617   END SUBROUTINE updateEN 
     618 
     619 
     620   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 
     621      !!--------------------------------------------- 
     622      !!           *** ROUTINE updateavt *** 
    624623      !!--------------------------------------------- 
    625624      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     
    629628      ! 
    630629      IF (before) THEN 
    631          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    632       ELSE 
    633          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    634       ENDIF 
    635       ! 
    636    END SUBROUTINE updateAVM 
    637  
    638  
    639    SUBROUTINE updateAVMu( ptab, i1, i2, j1, j2, k1, k2, before ) 
    640       !!--------------------------------------------- 
    641       !!           *** ROUTINE updateavmu *** 
     630         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
     631      ELSE 
     632         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     633      ENDIF 
     634      ! 
     635   END SUBROUTINE updateAVT 
     636 
     637 
     638   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 
     639      !!--------------------------------------------- 
     640      !!           *** ROUTINE updateavm *** 
    642641      !!--------------------------------------------- 
    643642      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     
    647646      ! 
    648647      IF (before) THEN 
    649          ptab  (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2) 
    650       ELSE 
    651          avmu_k(i1:i2,j1:j2,k1:k2) = ptab  (i1:i2,j1:j2,k1:k2)  
    652       ENDIF 
    653       ! 
    654    END SUBROUTINE updateAVMu 
    655  
    656  
    657    SUBROUTINE updateAVMv( ptab, i1, i2, j1, j2, k1, k2, before ) 
    658       !!--------------------------------------------- 
    659       !!           *** ROUTINE updateavmv *** 
    660       !!--------------------------------------------- 
    661       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    662       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    663       LOGICAL, INTENT(in) :: before 
    664       !!--------------------------------------------- 
    665       ! 
    666       IF (before) THEN 
    667          ptab  (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2) 
    668       ELSE 
    669          avmv_k(i1:i2,j1:j2,k1:k2) = ptab  (i1:i2,j1:j2,k1:k2)  
    670       ENDIF 
    671       ! 
    672    END SUBROUTINE updateAVMv 
     648         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     649      ELSE 
     650         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     651      ENDIF 
     652      ! 
     653   END SUBROUTINE updateAVM 
    673654 
    674655# endif /* key_zdftke */  
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r4984 r5081  
    316316   ! 
    317317# if defined key_zdftke 
    318    IF( ln_agrif_tke ) THEN 
    319318   CALL Agrif_Update_tke(0) 
    320    ENDIF     
    321319# endif 
    322320   ! 
     
    369367 
    370368# if defined key_zdftke 
     369   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    371370   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    372371   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
    373    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avmu_id) 
    374    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avmv_id) 
    375372# endif 
    376373 
     
    399396 
    400397# if defined key_zdftke 
    401    CALL Agrif_Set_bcinterp(avt_id ,interp=AGRIF_linear) 
    402398   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 
    403    CALL Agrif_Set_bcinterp(avmu_id,interp=AGRIF_linear) 
    404    CALL Agrif_Set_bcinterp(avmv_id,interp=AGRIF_linear) 
    405399# endif 
    406400 
     
    430424 
    431425# if defined key_zdftke 
    432    CALL Agrif_Set_bc(avt_id ,(/0,1/)) 
    433426   CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
    434    CALL Agrif_Set_bc(avmu_id,(/0,1/)) 
    435    CALL Agrif_Set_bc(avmv_id,(/0,1/)) 
    436427# endif 
    437428 
     
    451442 
    452443# if defined key_zdftke 
     444   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    453445   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    454446   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    455    CALL Agrif_Set_Updatetype(avmu_id, update = AGRIF_Update_Average) 
    456    CALL Agrif_Set_Updatetype(avmv_id, update = AGRIF_Update_Average) 
    457447# endif 
    458448 
     
    740730   INTEGER  ::   ios                 ! Local integer output status for namelist read 
    741731   INTEGER  ::   iminspon 
    742    NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy,   & 
    743                  &    ln_agrif_tke 
     732   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
    744733   !!-------------------------------------------------------------------------------------- 
    745734   ! 
     
    763752      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    764753      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    765       WRITE(numout,*) '      use TKE interpolation/update      ln_agrif_tke  = ', ln_agrif_tke 
    766754      WRITE(numout,*)  
    767755   ENDIF 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r4624 r5081  
    114114   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist 
    115115   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist 
    116    INTEGER ::   numond          =    7      !: logical unit for Output Namelist Dynamics 
     116   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics 
    117117   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist 
    118118   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist 
    119    INTEGER ::   numoni          =    8      !: logical unit for Output Namelist Ice 
     119   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice 
    120120   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution) 
    121121   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4785 r5081  
    14381438            END DO 
    14391439 
     1440            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    14401441            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    14411442            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r4789 r5081  
    4444   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2] 
    4647 
    4748   !!---------------------------------------------------------------------- 
     
    6263         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk),            & 
    6364         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk),            &  
    64          &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), STAT = zdf_oce_alloc ) 
     65         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk),            &  
     66         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 
    6567         ! 
    6668      IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r4789 r5081  
    4141   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag 
    4242   ! 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy 
    4443   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length 
    4544   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function 
     
    118117      !!                ***  FUNCTION zdf_gls_alloc  *** 
    119118      !!---------------------------------------------------------------------- 
    120       ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
     119      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
    121120         &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc ) 
    122121         ! 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4861 r5081  
    8888   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3) 
    8989 
    90    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2] 
    9190   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    9291   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
     92   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation 
    9393#if defined key_c1d 
    9494   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
     
    9696   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
    9797#endif 
    98    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wei3d          !  
    99    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   wmix           !  
    10098 
    10199   !! * Substitutions 
     
    118116         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    119117#endif 
    120          &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,    &  
     118         &      apdlr(jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &  
    121119         &      STAT= zdf_tke_alloc      ) 
    122120         ! 
    123121      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    124122      IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 
    125       ! 
    126       IF(.NOT. Agrif_Root()) THEN 
    127          ALLOCATE( wei3d(jpi,jpj,jpk), wmix(jpi,jpj), STAT= zdf_tke_alloc ) 
    128          IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    129          IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc2: failed to allocate arrays') 
    130       ENDIF 
    131123      ! 
    132124   END FUNCTION zdf_tke_alloc 
     
    181173      !!---------------------------------------------------------------------- 
    182174      ! 
     175#if defined key_agrif  
     176      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
     177      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke 
     178#endif 
     179      ! 
    183180      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
    184 #if defined key_agrif  
    185          ! interpolation parent grid => child grid for avt_k, avm_k, avmu_k, avmv_k  
    186          !( ex : at west border: update column 1 and 2) 
    187          IF(ln_agrif_tke) CALL Agrif_Tke    
    188 #endif 
    189181         avt (:,:,:) = avt_k (:,:,:)  
    190182         avm (:,:,:) = avm_k (:,:,:)  
     
    204196#if defined key_agrif 
    205197      ! Update child grid f => parent grid  
    206       IF( .NOT.Agrif_Root() .AND. ln_agrif_tke)    CALL Agrif_Update_Tke( kt )      ! children only 
     198      IF(lwp) WRITE(numout,*)  'sebseb', Agrif_Root(), kt, Agrif_NbStepint() 
     199      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only 
    207200#endif       
    208201     !  
     
    241234      INTEGER , POINTER, DIMENSION(:,:  ) :: imlc 
    242235      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc 
    243       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 
     236      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv 
     237      REAL(wp)                            ::   zri  !   local Richardson number 
    244238      !!-------------------------------------------------------------------- 
    245239      ! 
     
    248242      CALL wrk_alloc( jpi,jpj, imlc )    ! integer 
    249243      CALL wrk_alloc( jpi,jpj, zhlc )  
    250       CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )  
     244      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )  
    251245      ! 
    252246      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
     
    347341      ! 
    348342      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    349          DO jj = 1, jpj                 ! here avmu, avmv used as workspace 
    350             DO ji = 1, jpi 
    351                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   & 
    352                   &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &  
    353                   &           / (  fse3uw_n(ji,jj,jk)         & 
    354                   &              * fse3uw_b(ji,jj,jk) ) 
    355                avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   & 
    356                   &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   & 
    357                   &                            / (  fse3vw_n(ji,jj,jk)               & 
    358                   &                              *  fse3vw_b(ji,jj,jk)  ) 
    359             END DO 
    360          END DO 
    361       END DO 
    362       ! 
     343         DO jj = 1, jpjm1 
     344            DO ji = 1, fs_jpim1   ! vector opt. 
     345               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   & 
     346                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   & 
     347                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) / (  fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) ) 
     348               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   & 
     349                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   & 
     350                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) / (  fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 
     351            END DO 
     352         END DO 
     353      END DO 
     354      ! 
     355      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr 
     356         ! Note that zesh2 is also computed in the next loop. 
     357         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 
     358         DO jk = 2, jpkm1 
     359            DO jj = 2, jpjm1 
     360               DO ji = fs_2, fs_jpim1   ! vector opt. 
     361                  !                                          ! shear prod. at w-point weightened by mask 
     362                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
     363                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )     
     364                  !                                          ! local Richardson number 
     365                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear ) 
     366                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  ) 
     367                   
     368               END DO 
     369            END DO 
     370         END DO 
     371         ! 
     372      ENDIF 
     373         !          
    363374      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    364375         DO jj = 2, jpjm1 
     
    369380               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal 
    370381                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
    371                   !                                                           ! shear prod. at w-point weightened by mask 
    372                zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    373                   &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )     
    374                   ! 
     382               !                                   ! shear prod. at w-point weightened by mask 
     383               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
     384                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )     
     385               ! 
    375386               zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw) 
    376387               zd_lw(ji,jj,jk) = zzd_lw 
     
    465476      CALL wrk_dealloc( jpi,jpj, imlc )    ! integer 
    466477      CALL wrk_dealloc( jpi,jpj, zhlc )  
    467       CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )  
     478      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )  
    468479      ! 
    469480      IF( nn_timing == 1 )  CALL timing_stop('tke_tke') 
     
    509520      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    510521      REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars 
    511       REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      - 
     522      REAL(wp) ::   zdku, zri, zsqen     !   -      - 
    512523      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      - 
    513       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmp2d 
    514524      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld 
    515525      !!-------------------------------------------------------------------- 
     
    517527      IF( nn_timing == 1 )  CALL timing_start('tke_avn') 
    518528 
    519       CALL wrk_alloc( jpi,jpj, ztmp2d )  
    520529      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )  
    521530 
     
    649658      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    650659      ! 
    651 # if defined key_agrif 
    652       IF( .NOT. AGRIF_Root() ) THEN 
    653          IF( ln_agrif_tke ) THEN 
    654             DO jk = 1, jpkm1 
    655                DO jj = 2, jpjm1 
    656                   DO ji = 2, jpim1 
    657                      ztmp2d(ji,jj) = 1. * avm(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk)   & 
    658                            &          + 2. * avm(ji  ,jj-1,jk) * tmask(ji  ,jj-1,jk)   & 
    659                            &          + 1. * avm(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk)   & 
    660                            &          + 2. * avm(ji-1,jj  ,jk) * tmask(ji-1,jj  ,jk)   & 
    661                            &          + 4. * avm(ji  ,jj  ,jk) * tmask(ji  ,jj  ,jk)   & 
    662                            &          + 2. * avm(ji+1,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
    663                            &          + 1. * avm(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk)   & 
    664                            &          + 2. * avm(ji  ,jj+1,jk) * tmask(ji  ,jj+1,jk)   & 
    665                            &          + 1. * avm(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 
    666                   END DO 
    667                END DO 
    668                DO jj = 2, jpjm1 
    669                   DO ji = 2, jpim1 
    670                      avm(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avm(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 
    671                   END DO 
    672                END DO 
    673             END DO 
    674             CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    675             DO jk = 1, jpkm1 
    676                DO jj = 2, jpjm1 
    677                   DO ji = 2, jpim1 
    678                      ztmp2d(ji,jj) = 1. * avt(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk)   & 
    679                            &          + 2. * avt(ji  ,jj-1,jk) * tmask(ji  ,jj-1,jk)   & 
    680                            &          + 1. * avt(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk)   & 
    681                            &          + 2. * avt(ji-1,jj  ,jk) * tmask(ji-1,jj  ,jk)   & 
    682                            &          + 4. * avt(ji  ,jj  ,jk) * tmask(ji  ,jj  ,jk)   & 
    683                            &          + 2. * avt(ji+1,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
    684                            &          + 1. * avt(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk)   & 
    685                            &          + 2. * avt(ji  ,jj+1,jk) * tmask(ji  ,jj+1,jk)   & 
    686                            &          + 1. * avt(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 
    687                   END DO 
    688                END DO 
    689                DO jj = 2, jpjm1 
    690                   DO ji = 2, jpim1 
    691                      avt(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avt(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 
    692                   END DO 
    693                END DO 
    694             END DO 
    695             CALL lbc_lnk( avt, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    696          ELSE    
    697             DO jk = 1, jpkm1 
    698                IF ((nbondi ==  1).OR.(nbondi == 2)) avmu(nlci-1 , :     ,jk) = avmu(nlci-2 , :     ,jk)     !   east 
    699                IF ((nbondi == -1).OR.(nbondi == 2)) avmu(1      , :     ,jk) = avmu(2      , :     ,jk)     !   west 
    700                IF ((nbondj ==  1).OR.(nbondj == 2)) avmv(:      ,nlcj-1 ,jk) = avmv(:      ,nlcj-2 ,jk)     !   north 
    701                IF ((nbondj == -1).OR.(nbondj == 2)) avmv(:      ,1      ,jk) = avmv(:      ,2      ,jk)     !   south 
    702             END DO 
    703          ENDIF 
    704       ENDIF 
    705 # endif /* key_Agrif */ 
    706       ! 
    707660      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points 
    708661         DO jj = 2, jpjm1 
     
    719672            DO jj = 2, jpjm1 
    720673               DO ji = fs_2, fs_jpim1   ! vector opt. 
    721                   zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
    722                   !                                          ! shear 
    723                   zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   & 
    724                     &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) ) 
    725                   zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   & 
    726                     &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) ) 
    727                   !                                          ! local Richardson number 
    728                   zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear ) 
    729                   zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  ) 
    730 !!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!) 
    731 !!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  ) 
    732                   avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
     674                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
    733675# if defined key_c1d 
    734                   e_pdl(ji,jj,jk) = zpdlr * tmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number 
     676                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * tmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number 
    735677                  e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk)                            ! c1d config. : save Ri 
    736678# endif 
     
    747689      ENDIF 
    748690      ! 
    749       CALL wrk_dealloc( jpi,jpj, ztmp2d )  
    750691      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )  
    751692      ! 
     
    852793      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
    853794      ! 
    854       IF(.NOT. Agrif_Root()) THEN 
    855          wei3d(:,:,:) = 1. 
    856          DO jk = 1, jpkm1 
    857             DO jj = 2, jpjm1 
    858                DO ji = 2, jpim1 
    859                   wei3d(ji,jj,jk) =   & 
    860                      &   1.*tmask(ji-1,jj-1,jk) + 2.*tmask(ji,jj-1,jk) + 1.*tmask(ji+1,jj-1,jk)& 
    861                      & + 2.*tmask(ji-1,jj  ,jk) + 4.*tmask(ji,jj  ,jk) + 2.*tmask(ji+1,jj  ,jk)& 
    862                      & + 1.*tmask(ji-1,jj+1,jk) + 2.*tmask(ji,jj+1,jk) + 1.*tmask(ji+1,jj+1,jk) 
    863                   wei3d(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1., wei3d(ji,jj,jk) ) 
    864                END DO 
    865             END DO 
    866          END DO 
    867          CALL lbc_lnk( wei3d, 'T', 1. ) 
    868  
    869          wmix(:,:) = 0. 
    870          wmix(mi0(2):mi1(jpiglo-1),mj0(2):mj1(jpjglo-1)) = 1. 
    871          wmix(mi0(6):mi1(jpiglo-5),mj0(6):mj1(jpjglo-5)) = 0.75 
    872          wmix(mi0(7):mi1(jpiglo-6),mj0(7):mj1(jpjglo-6)) = 0.5 
    873          wmix(mi0(8):mi1(jpiglo-7),mj0(8):mj1(jpjglo-7)) = 0.25 
    874          wmix(mi0(9):mi1(jpiglo-8),mj0(9):mj1(jpjglo-8)) = 0. 
    875       END IF 
    876       !   
    877795   END SUBROUTINE zdf_tke_init 
    878796 
Note: See TracChangeset for help on using the changeset viewer.