Changeset 11868


Ignore:
Timestamp:
2019-11-06T16:43:51+01:00 (9 months ago)
Author:
jchanut
Message:

#2222, 1) Correct sponge mainly for using AGRIF in 2DV domains, 2) Add check of bathymetry consistency

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90

    r11802 r11868  
    719719               tsa(ji,jj,:,:) = 0._wp 
    720720               N_in = mbkt_parent(ji,jj) 
    721                IF ( tmask(ji,jj,1) == 0._wp) N_in = 0 
    722721               zhtot = 0._wp 
    723722               DO jk=1,N_in !k2 = jpk of parent grid 
     
    834833               N_in = mbku_parent(ji,jj) 
    835834               zhtot = 0._wp 
    836                IF ( umask(ji,jj,1) == 0._wp) N_in = 0 
    837835               DO jk=1,N_in 
    838836                  IF (jk==N_in) THEN 
     
    930928               va(ji,jj,:) = 0._wp 
    931929               N_in = mbkv_parent(ji,jj) 
    932                IF ( vmask(ji,jj,1) == 0._wp) N_in = 0 
    933930               zhtot = 0._wp 
    934931               DO jk=1,N_in 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_sponge.F90

    r11827 r11868  
    6060#endif 
    6161      ! 
    62       CALL iom_put("agrif_spu", fspu(:,:)) 
    63       CALL iom_put("agrif_spv", fspv(:,:)) 
     62      CALL iom_put( 'agrif_spu', fspu(:,:)) 
     63      CALL iom_put( 'agrif_spv', fspv(:,:)) 
    6464      ! 
    6565   END SUBROUTINE Agrif_Sponge_Tra 
     
    9090#endif 
    9191      ! 
    92       CALL iom_put("agrif_spt", fspt(:,:)) 
    93       CALL iom_put("agrif_spf", fspf(:,:)) 
     92      CALL iom_put( 'agrif_spt', fspt(:,:)) 
     93      CALL iom_put( 'agrif_spf', fspf(:,:)) 
    9494      ! 
    9595   END SUBROUTINE Agrif_Sponge_dyn 
     
    128128         ind1 = 1+nbghostcells 
    129129         DO ji = mi0(ind1), mi1(ind1)                 
    130             ztabramp(ji,:) = umask(ji,:,1) 
     130            ztabramp(ji,:) = ssumask(ji,:) 
    131131         END DO 
    132132         ! 
     
    138138         ind1 = jpiglo - nbghostcells - 1 
    139139         DO ji = mi0(ind1), mi1(ind1)                  
    140             ztabramp(ji,:) = umask(ji,:,1) 
     140            ztabramp(ji,:) = ssumask(ji,:) 
    141141         END DO 
    142142         ! 
     
    148148         ind1 = 1+nbghostcells 
    149149         DO jj = mj0(ind1), mj1(ind1)                  
    150             ztabramp(:,jj) = vmask(:,jj,1) 
     150            ztabramp(:,jj) = ssvmask(:,jj) 
    151151         END DO 
    152152         ! 
     
    158158         ind1 = jpjglo - nbghostcells - 1 
    159159         DO jj = mj0(ind1), mj1(ind1)                  
    160             ztabramp(:,jj) = vmask(:,jj,1) 
     160            ztabramp(:,jj) = ssvmask(:,jj) 
    161161         END DO 
    162162         ! 
     
    180180          
    181181         ztabramp(:,:) = 0._wp 
    182          IF ( Agrif_irhox()==1 ) ispongearea =-1 
    183          IF ( Agrif_irhoy()==1 ) jspongearea =-1 
     182 
     183         ! Trick to remove sponge in 2DV domains: 
     184         IF ( nbcellsx <= 3 ) ispongearea = -1 
     185         IF ( nbcellsy <= 3 ) jspongearea = -1 
    184186 
    185187         ! --- West --- ! 
     
    192194         END DO 
    193195 
    194          ! ghost cells (cosmetic): 
     196         ! ghost cells: 
    195197         ind1 = 1 
    196          ind2 = nbghostcells 
     198         ind2 = nbghostcells + 1 
    197199         DO ji = mi0(ind1), mi1(ind2)    
    198200            DO jj = 1, jpj                
     
    210212         END DO 
    211213 
    212          ! ghost cells (cosmetic): 
    213          ind1 = jpiglo - nbghostcells + 1 
     214         ! ghost cells: 
     215         ind1 = jpiglo - nbghostcells 
    214216         ind2 = jpiglo 
    215217         DO ji = mi0(ind1), mi1(ind2) 
     
    228230         END DO 
    229231 
    230          ! ghost cells (cosmetic): 
     232         ! ghost cells: 
    231233         ind1 = 1 
    232          ind2 = nbghostcells 
     234         ind2 = nbghostcells + 1 
    233235         DO jj = mj0(ind1), mj1(ind2)  
    234236            DO ji = 1, jpi 
     
    246248         END DO 
    247249 
    248          ! ghost cells (cosmetic): 
    249          ind1 = jpjglo - nbghostcells + 1 
     250         ! ghost cells: 
     251         ind1 = jpjglo - nbghostcells 
    250252         ind2 = jpjglo 
    251253         DO jj = mj0(ind1), mj1(ind2) 
     
    263265         DO jj = 2, jpjm1 
    264266            DO ji = 2, jpim1   ! vector opt. 
    265                fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
    266                fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) 
     267               fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) * ssumask(ji,jj) 
     268               fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj) 
    267269            END DO 
    268270         END DO 
     
    279281         DO jj = 2, jpjm1 
    280282            DO ji = 2, jpim1   ! vector opt. 
    281                fspt(ji,jj) = ztabramp(ji,jj) 
    282                fspf(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1) & 
    283                                      &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) 
     283               fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj) 
     284               fspf(ji,jj) = 0.25_wp * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1)   & 
     285                                     &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) & 
     286                                     &  * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    284287            END DO 
    285288         END DO 
     
    291294 
    292295#if defined key_vertical 
    293       ! Trick to vertical remove interpolation in sponge layer in case of 2DV domains: 
     296      ! Remove vertical interpolation where not needed: 
    294297      DO jj = 2, jpjm1 
    295298         DO ji = 2, jpim1 
     
    303306            &   (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0 
    304307! 
    305             IF (mbkt(ji,jj) == 0) mbkt_parent(ji,jj) = 0 
    306             IF (mbku(ji,jj) == 0) mbku_parent(ji,jj) = 0 
    307             IF (mbkv(ji,jj) == 0) mbkv_parent(ji,jj) = 0 
     308            IF ( ssmask(ji,jj) == 0._wp) mbkt_parent(ji,jj) = 0 
     309            IF (ssumask(ji,jj) == 0._wp) mbku_parent(ji,jj) = 0 
     310            IF (ssvmask(ji,jj) == 0._wp) mbkv_parent(ji,jj) = 0 
    308311         END DO 
    309312      END DO 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90

    r11827 r11868  
    126126      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
    127127      ! 
     128      ! Assume step wise change of bathymetry near interface 
     129      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case 
     130      !       and no refinement 
    128131      DO jj = 1, jpjm1 
    129132         DO ji = 1, jpim1 
     
    140143      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    141144      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
    142       mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )       
     145      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    143146#endif 
    144147 
     
    238241         ENDIF 
    239242 
    240          ! check if masks and bathymetries match 
    241          IF(ln_chk_bathy) THEN 
    242             ! 
    243             IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    244             ! 
    245             kindic_agr = 0 
    246             ! check if umask agree with parent along western and eastern boundaries: 
    247             CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
    248             ! check if vmask agree with parent along northern and southern boundaries: 
    249             CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
    250             ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
    251             CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    252             ! 
    253             CALL mpp_sum( 'agrif_user', kindic_agr ) 
    254             IF( kindic_agr /= 0 ) THEN 
    255                CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
    256             ELSE 
    257                IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
    258             END IF 
    259          ENDIF 
    260  
    261 #if defined key_vertical 
    262     IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
    263        CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
    264          ENDIF 
    265 #endif 
     243      ENDIF 
     244 
     245      ! check if masks and bathymetries match 
     246      IF(ln_chk_bathy) THEN 
    266247         ! 
    267       ENDIF 
     248         IF(lwp) WRITE(numout,*) ' ' 
     249         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     250         ! 
     251         kindic_agr = 0 
     252# if ! defined key_vertical 
     253         ! 
     254         ! check if umask agree with parent along western and eastern boundaries: 
     255         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
     256         ! check if vmask agree with parent along northern and southern boundaries: 
     257         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
     258         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     259         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     260         ! 
     261# else 
     262         ! 
     263         ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     264         DO ji = 1, jpi 
     265            DO jj = 1, jpj 
     266               IF ((mbkt_parent(ji,jj)/=0).AND.(ht0_parent(ji,jj)/=ht_0(ji,jj))) kindic_agr = kindic_agr + 1 
     267               IF ((mbku_parent(ji,jj)/=0).AND.(hu0_parent(ji,jj)/=hu_0(ji,jj))) kindic_agr = kindic_agr + 1 
     268               IF ((mbkv_parent(ji,jj)/=0).AND.(hv0_parent(ji,jj)/=hv_0(ji,jj))) kindic_agr = kindic_agr + 1 
     269            END DO 
     270         END DO 
     271# endif 
     272         CALL mpp_sum( 'agrif_user', kindic_agr ) 
     273         IF( kindic_agr /= 0 ) THEN 
     274            CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     275         ELSE 
     276            IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     277            IF(lwp) WRITE(numout,*) ' ' 
     278         END IF   
     279         !     
     280      ENDIF 
     281 
     282# if defined key_vertical 
     283      ! Additional constrain that should be removed someday: 
     284      IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     285    CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
     286      ENDIF 
     287# endif 
    268288      !  
    269289   END SUBROUTINE Agrif_InitValues_cont 
     
    379399      ! 3. Location of interpolation 
    380400      !----------------------------- 
    381       CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) 
    382       CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 
     401      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     402      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )  
    383403      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) ) 
    384404 
    385       CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9  
    386       CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
    387       CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
     405      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2  
     406      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3:  
     407      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11 
    388408 
    389409      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) ) 
     
    393413      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    394414 
    395       CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6  
    396       CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 
    397       CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 
    398 # if defined key_vertical 
     415      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )     ! if west,  rhox=3, nn_sponge_len=2 
     416      CALL Agrif_Set_bc( umsk_id, (/0,0/) )                                     ! and nbghost=3: 
     417      CALL Agrif_Set_bc( vmsk_id, (/0,0/) )                                     ! columns 2 to 10 
     418# if defined key_vertical  
    399419      ! extend the interpolation zone by 1 more point than necessary: 
    400420      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
Note: See TracChangeset for help on using the changeset viewer.