Ignore:
Timestamp:
12/17/13 23:25:54 (10 years ago)
Author:
smasson
Message:

agrif fixes

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r1 r85  
    4242   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s] 
    4343   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
    4446  
    4547   !!---------------------------------------------------------------------- 
     
    5860         &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      & 
    5961         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      & 
    60          &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           , STAT = zdf_oce_alloc ) 
     62         &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           ,      & 
     63         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      & 
     64         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      & 
     65         &     STAT = zdf_oce_alloc ) 
    6166         ! 
    6267      IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r46 r85  
    5151   USE wrk_nemo       ! work arrays 
    5252   USE timing         ! Timing 
     53#if defined key_agrif 
     54   USE agrif_opa_interp 
     55   USE agrif_opa_update 
     56#endif 
    5357 
    5458   IMPLICIT NONE 
     
    8690   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    8791   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    88    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
    89    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
    9092#if defined key_c1d 
    9193   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
     
    9395   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
    9496#endif 
     97   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wei3d          !  
     98   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   wmix           !  
    9599 
    96100   !! * Substitutions 
     
    113117         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    114118#endif 
    115          &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &  
    116          &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          & 
    117          &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      ) 
     119         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,    &  
     120         &      STAT= zdf_tke_alloc      ) 
    118121         ! 
    119122      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    120123      IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 
     124      ! 
     125      IF(.NOT. Agrif_Root()) THEN 
     126         ALLOCATE( wei3d(jpi,jpj,jpk), wmix(jpi,jpj), STAT= zdf_tke_alloc ) 
     127         IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
     128         IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc2: failed to allocate arrays') 
     129      ENDIF 
    121130      ! 
    122131   END FUNCTION zdf_tke_alloc 
     
    172181      ! 
    173182      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
     183#if defined key_agrif  
     184         ! interpolation parent grid => child grid for avt_k, avm_k, avmu_k, avmv_k (at west border: update column 1 and 2) 
     185         CALL Agrif_Tke    
     186#endif 
    174187         avt (:,:,:) = avt_k (:,:,:)  
    175188         avm (:,:,:) = avm_k (:,:,:)  
     
    187200      avmv_k(:,:,:) = avmv(:,:,:)  
    188201      ! 
     202#if defined key_agrif 
     203      ! Update child grid f => parent grid  
     204      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tke( kt )      ! children only 
     205#endif       
     206 
     207 
    189208   END SUBROUTINE zdf_tke 
    190209 
     
    491510      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      - 
    492511      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      - 
     512      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmp2d 
    493513      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld 
    494514      !!-------------------------------------------------------------------- 
     
    496516      IF( nn_timing == 1 )  CALL timing_start('tke_avn') 
    497517 
     518      CALL wrk_alloc( jpi,jpj, ztmp2d )  
    498519      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )  
    499520 
     
    626647      END DO 
    627648      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
     649      ! 
     650      IF(.NOT. Agrif_Root()) THEN 
     651          
     652         DO jk = 1, jpkm1 
     653            DO jj = 2, jpjm1 
     654               DO ji = 2, jpim1 
     655                  ztmp2d(ji,jj) = 1. * avm(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk)   & 
     656                     &          + 2. * avm(ji  ,jj-1,jk) * tmask(ji  ,jj-1,jk)   & 
     657                     &          + 1. * avm(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk)   & 
     658                     &          + 2. * avm(ji-1,jj  ,jk) * tmask(ji-1,jj  ,jk)   & 
     659                     &          + 4. * avm(ji  ,jj  ,jk) * tmask(ji  ,jj  ,jk)   & 
     660                     &          + 2. * avm(ji+1,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
     661                     &          + 1. * avm(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk)   & 
     662                     &          + 2. * avm(ji  ,jj+1,jk) * tmask(ji  ,jj+1,jk)   & 
     663                     &          + 1. * avm(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     664               END DO 
     665            END DO 
     666            DO jj = 2, jpjm1 
     667               DO ji = 2, jpim1 
     668                  avm(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avm(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 
     669               END DO 
     670            END DO 
     671         END DO 
     672         CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
     673         DO jk = 1, jpkm1 
     674            DO jj = 2, jpjm1 
     675               DO ji = 2, jpim1 
     676                  ztmp2d(ji,jj) = 1. * avt(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk)   & 
     677                     &          + 2. * avt(ji  ,jj-1,jk) * tmask(ji  ,jj-1,jk)   & 
     678                     &          + 1. * avt(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk)   & 
     679                     &          + 2. * avt(ji-1,jj  ,jk) * tmask(ji-1,jj  ,jk)   & 
     680                     &          + 4. * avt(ji  ,jj  ,jk) * tmask(ji  ,jj  ,jk)   & 
     681                     &          + 2. * avt(ji+1,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
     682                     &          + 1. * avt(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk)   & 
     683                     &          + 2. * avt(ji  ,jj+1,jk) * tmask(ji  ,jj+1,jk)   & 
     684                     &          + 1. * avt(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     685               END DO 
     686            END DO 
     687            DO jj = 2, jpjm1 
     688               DO ji = 2, jpim1 
     689                  avt(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avt(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 
     690               END DO 
     691            END DO 
     692         END DO 
     693         CALL lbc_lnk( avt, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
     694 
     695      END IF 
    628696      ! 
    629697      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points 
     
    662730      ENDIF 
    663731      CALL lbc_lnk( avt, 'W', 1. )                      ! Lateral boundary conditions on avt  (sign unchanged) 
    664  
     732      ! 
    665733      IF(ln_ctl) THEN 
    666734         CALL prt_ctl( tab3d_1=en  , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
     
    669737      ENDIF 
    670738      ! 
     739      CALL wrk_dealloc( jpi,jpj, ztmp2d )  
    671740      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld )  
    672741      ! 
     
    766835      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
    767836      ! 
     837      IF(.NOT. Agrif_Root()) THEN 
     838 
     839         wei3d(:,:,:) = 1. 
     840         DO jk = 1, jpkm1 
     841            DO jj = 2, jpjm1 
     842               DO ji = 2, jpim1   
     843                  wei3d(ji,jj,jk) =   & 
     844                     &   1.*tmask(ji-1,jj-1,jk) + 2.*tmask(ji,jj-1,jk) + 1.*tmask(ji+1,jj-1,jk)& 
     845                     & + 2.*tmask(ji-1,jj  ,jk) + 4.*tmask(ji,jj  ,jk) + 2.*tmask(ji+1,jj  ,jk)& 
     846                     & + 1.*tmask(ji-1,jj+1,jk) + 2.*tmask(ji,jj+1,jk) + 1.*tmask(ji+1,jj+1,jk) 
     847                  wei3d(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1., wei3d(ji,jj,jk) ) 
     848               END DO 
     849            END DO 
     850         END DO 
     851         CALL lbc_lnk( wei3d, 'T', 1. ) 
     852 
     853         wmix(:,:) = 0. 
     854         wmix(mi0(2):mi1(jpiglo-1),mj0(2):mj1(jpjglo-1)) = 1. 
     855         wmix(mi0(6):mi1(jpiglo-5),mj0(6):mj1(jpjglo-5)) = 0.75 
     856         wmix(mi0(7):mi1(jpiglo-6),mj0(7):mj1(jpjglo-6)) = 0.5 
     857         wmix(mi0(8):mi1(jpiglo-7),mj0(8):mj1(jpjglo-7)) = 0.25 
     858         wmix(mi0(9):mi1(jpiglo-8),mj0(9):mj1(jpjglo-8)) = 0. 
     859 
     860      END IF 
     861 
    768862   END SUBROUTINE zdf_tke_init 
    769863 
Note: See TracChangeset for help on using the changeset viewer.