Changeset 11868 for NEMO/branches
- Timestamp:
- 2019-11-06T16:43:51+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
- Files:
-
- 3 edited
-
agrif_oce_interp.F90 (modified) (3 diffs)
-
agrif_oce_sponge.F90 (modified) (15 diffs)
-
agrif_user.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90
r11802 r11868 719 719 tsa(ji,jj,:,:) = 0._wp 720 720 N_in = mbkt_parent(ji,jj) 721 IF ( tmask(ji,jj,1) == 0._wp) N_in = 0722 721 zhtot = 0._wp 723 722 DO jk=1,N_in !k2 = jpk of parent grid … … 834 833 N_in = mbku_parent(ji,jj) 835 834 zhtot = 0._wp 836 IF ( umask(ji,jj,1) == 0._wp) N_in = 0837 835 DO jk=1,N_in 838 836 IF (jk==N_in) THEN … … 930 928 va(ji,jj,:) = 0._wp 931 929 N_in = mbkv_parent(ji,jj) 932 IF ( vmask(ji,jj,1) == 0._wp) N_in = 0933 930 zhtot = 0._wp 934 931 DO jk=1,N_in -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_sponge.F90
r11827 r11868 60 60 #endif 61 61 ! 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(:,:)) 64 64 ! 65 65 END SUBROUTINE Agrif_Sponge_Tra … … 90 90 #endif 91 91 ! 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(:,:)) 94 94 ! 95 95 END SUBROUTINE Agrif_Sponge_dyn … … 128 128 ind1 = 1+nbghostcells 129 129 DO ji = mi0(ind1), mi1(ind1) 130 ztabramp(ji,:) = umask(ji,:,1)130 ztabramp(ji,:) = ssumask(ji,:) 131 131 END DO 132 132 ! … … 138 138 ind1 = jpiglo - nbghostcells - 1 139 139 DO ji = mi0(ind1), mi1(ind1) 140 ztabramp(ji,:) = umask(ji,:,1)140 ztabramp(ji,:) = ssumask(ji,:) 141 141 END DO 142 142 ! … … 148 148 ind1 = 1+nbghostcells 149 149 DO jj = mj0(ind1), mj1(ind1) 150 ztabramp(:,jj) = vmask(:,jj,1)150 ztabramp(:,jj) = ssvmask(:,jj) 151 151 END DO 152 152 ! … … 158 158 ind1 = jpjglo - nbghostcells - 1 159 159 DO jj = mj0(ind1), mj1(ind1) 160 ztabramp(:,jj) = vmask(:,jj,1)160 ztabramp(:,jj) = ssvmask(:,jj) 161 161 END DO 162 162 ! … … 180 180 181 181 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 184 186 185 187 ! --- West --- ! … … 192 194 END DO 193 195 194 ! ghost cells (cosmetic):196 ! ghost cells: 195 197 ind1 = 1 196 ind2 = nbghostcells 198 ind2 = nbghostcells + 1 197 199 DO ji = mi0(ind1), mi1(ind2) 198 200 DO jj = 1, jpj … … 210 212 END DO 211 213 212 ! ghost cells (cosmetic):213 ind1 = jpiglo - nbghostcells + 1214 ! ghost cells: 215 ind1 = jpiglo - nbghostcells 214 216 ind2 = jpiglo 215 217 DO ji = mi0(ind1), mi1(ind2) … … 228 230 END DO 229 231 230 ! ghost cells (cosmetic):232 ! ghost cells: 231 233 ind1 = 1 232 ind2 = nbghostcells 234 ind2 = nbghostcells + 1 233 235 DO jj = mj0(ind1), mj1(ind2) 234 236 DO ji = 1, jpi … … 246 248 END DO 247 249 248 ! ghost cells (cosmetic):249 ind1 = jpjglo - nbghostcells + 1250 ! ghost cells: 251 ind1 = jpjglo - nbghostcells 250 252 ind2 = jpjglo 251 253 DO jj = mj0(ind1), mj1(ind2) … … 263 265 DO jj = 2, jpjm1 264 266 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) 267 269 END DO 268 270 END DO … … 279 281 DO jj = 2, jpjm1 280 282 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) 284 287 END DO 285 288 END DO … … 291 294 292 295 #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: 294 297 DO jj = 2, jpjm1 295 298 DO ji = 2, jpim1 … … 303 306 & (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0 304 307 ! 305 IF ( mbkt(ji,jj) == 0) mbkt_parent(ji,jj) = 0306 IF ( mbku(ji,jj) == 0) mbku_parent(ji,jj) = 0307 IF ( mbkv(ji,jj) == 0) mbkv_parent(ji,jj) = 0308 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 308 311 END DO 309 312 END DO -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90
r11827 r11868 126 126 CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 127 127 ! 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 128 131 DO jj = 1, jpjm1 129 132 DO ji = 1, jpim1 … … 140 143 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 141 144 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 ) 143 146 #endif 144 147 … … 238 241 ENDIF 239 242 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 266 247 ! 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 268 288 ! 269 289 END SUBROUTINE Agrif_InitValues_cont … … 379 399 ! 3. Location of interpolation 380 400 !----------------------------- 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/) ) 383 403 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) ) 384 404 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 9386 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 388 408 389 409 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) ) … … 393 413 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 394 414 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 6396 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 399 419 ! extend the interpolation zone by 1 more point than necessary: 400 420 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
Note: See TracChangeset
for help on using the changeset viewer.
