Changeset 9628
 Timestamp:
 20180524T11:16:05+02:00 (5 years ago)
 Location:
 utils/tools/NESTING/src
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

utils/tools/NESTING/src/agrif_create_bathy.f90
r9166 r9628 53 53 REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps_interp => NULL() 54 54 REAL*8, DIMENSION(:,:),POINTER :: save_gdepw,rx,ry,maskedtopo 55 REAL*8, DIMENSION(:,:),POINTER :: wtab => NULL()56 55 REAL*8 :: Cell_lonmin,Cell_lonmax,Cell_latmin,Cell_latmax,wghts 57 56 LOGICAL :: Pacifique=.FALSE. … … 460 459 ! 461 460 boundary = connectionsize*irafx + nbghostcellsfine + 1 462 G1%gdepw_ps(1:boundary,:) = gdepw_ps_interp(1:boundary,:) 463 G1%gdepw_ps(:,1:boundary) = gdepw_ps_interp(:,1:boundary) 464 G1%gdepw_ps(nxfinboundary+1:nxfin,:) = gdepw_ps_interp(nxfinboundary+1:nxfin,:) 465 G1%gdepw_ps(:,nyfinboundary+1:nyfin) = gdepw_ps_interp(:,nyfinboundary+1:nyfin) 466 467 461 ! J chanut: exclude matching if no open boundaries 462 IF (.NOT.ASSOCIATED(G1%wgt)) & 463 ALLOCATE(G1%wgt(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2))) 464 G1%wgt(:,:) = 0. 465 466 DO jj=1,nyfin 467 ! West 468 IF (gdepw_ps_interp(nbghostcellsfine+1,jj)>0.) THEN 469 G1%gdepw_ps(1:boundary,jj) = gdepw_ps_interp(1:boundary,jj) 470 G1%wgt(1:boundary,jj) = 1. 471 ELSE 472 G1%gdepw_ps(1:nbghostcellsfine+1,jj)=0. 473 ENDIF 474 ! East 475 IF (gdepw_ps_interp(nxfinnbghostcellsfine,jj)>0.) THEN 476 G1%gdepw_ps(nxfinboundary+1:nxfin,jj)=gdepw_ps_interp(nxfinboundary+1:nxfin,jj) 477 G1%wgt(nxfinboundary+1:nxfin,jj) = 1. 478 ELSE 479 G1%gdepw_ps(nxfinnbghostcellsfine:nxfin,jj) = 0. 480 ENDIF 481 END DO 482 DO ji=1,nxfin 483 ! South 484 IF (gdepw_ps_interp(ji,nbghostcellsfine+1)>0.) THEN 485 G1%gdepw_ps(ji,1:boundary) = gdepw_ps_interp(ji,1:boundary) 486 G1%wgt(ji,1:boundary) = 1. 487 ELSE 488 G1%gdepw_ps(ji,1:nbghostcellsfine+1)=0. 489 ENDIF 490 ! North 491 IF (gdepw_ps_interp(ji,nyfinnbghostcellsfine)>0.) THEN 492 G1%gdepw_ps(ji,nyfinboundary+1:nyfin)=gdepw_ps_interp(ji,nyfinboundary+1:nyfin) 493 G1%wgt(ji,nyfinboundary+1:nyfin) = 1. 494 ELSE 495 G1%gdepw_ps(ji,nyfinnbghostcellsfine:nyfin) = 0. 496 ENDIF 497 END DO 498 499 ! G1%gdepw_ps(1:boundary,:) = gdepw_ps_interp(1:boundary,:) 500 ! G1%gdepw_ps(:,1:boundary) = gdepw_ps_interp(:,1:boundary) 501 ! G1%gdepw_ps(nxfinboundary+1:nxfin,:) = gdepw_ps_interp(nxfinboundary+1:nxfin,:) 502 ! G1%gdepw_ps(:,nyfinboundary+1:nyfin) = gdepw_ps_interp(:,nyfinboundary+1:nyfin) 468 503 ! 469 504 … … 485 520 ! 486 521 ! 487 IF (.NOT.ASSOCIATED(wtab)) &488 ALLOCATE(wtab(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))489 wtab(:,:) = 0.490 522 wghts = 1. 491 523 DO ji = boundary + 1 , boundary + nb_connection_pts * irafx 492 524 wghts = wghts  (1. / (nb_connection_pts*irafx  1. ) ) 493 DO jj=boundary+1,nyfinboundary 494 wtab(ji,jj) = MAX(wghts, wtab(ji,jj)) 525 DO jj=1,nyfin 526 IF (G1%gdepw_ps(nbghostcellsfine+1,jj) > 0.) THEN 527 G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj)) 528 ENDIF 495 529 END DO 496 530 END DO … … 499 533 DO ji = nxfin  boundary , nxfin  boundary  nb_connection_pts * irafx +1 , 1 500 534 wghts = wghts  (1. / (nb_connection_pts*irafx  1. ) ) 501 DO jj=boundary+1,nyfinboundary 502 wtab(ji,jj) = MAX(wghts, wtab(ji,jj)) 535 DO jj=1,nyfin 536 IF (G1%gdepw_ps(nxfinnbghostcellsfine,jj) > 0.) THEN 537 G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj)) 538 ENDIF 503 539 END DO 504 540 END DO … … 507 543 DO jj = boundary + 1 , boundary + nb_connection_pts * irafy 508 544 wghts = wghts  (1. / (nb_connection_pts*irafy  1. ) ) 509 DO ji=boundary+1,nxfinboundary 510 wtab(ji,jj) = MAX(wghts, wtab(ji,jj)) 545 DO ji=1,nxfin 546 IF (G1%gdepw_ps(ji,nbghostcellsfine+1) > 0.) THEN 547 G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj)) 548 ENDIF 511 549 END DO 512 550 END DO … … 515 553 DO jj = nyfin  boundary , nyfin  boundary  nb_connection_pts * irafy +1, 1 516 554 wghts = wghts  (1. / (nb_connection_pts*irafy  1. ) ) 517 DO ji=boundary+1,nxfinboundary 518 wtab(ji,jj) = MAX(wghts, wtab(ji,jj)) 555 DO ji=1,nxfin 556 IF (G1%gdepw_ps(ji,nyfinnbghostcellsfine) > 0.) THEN 557 G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj)) 558 ENDIF 519 559 END DO 520 560 END DO 521 561 522 G1%gdepw_ps(:,:) = (1. wtab(:,:)) * G1%gdepw_ps(:,:) + gdepw_ps_interp(:,:)*wtab(:,:)562 G1%gdepw_ps(:,:) = (1.G1%wgt(:,:)) * G1%gdepw_ps(:,:) + gdepw_ps_interp(:,:)*G1%wgt(:,:) 523 563 524 564 G1%bathy_meter = G1%gdepw_ps … … 526 566 connectionsize = 2 527 567 ! 528 IF(smoothing) THEN 568 ! Chanut: remove smoothing if child grid bathymetry is found to already exist 569 IF(smoothing.AND.(.NOT.identical_grids)) THEN 529 570 530 571 ! 531 572 ! Smoothing to connect the connection zone (3 + nb_connection_pts coarse grid cells) and the interior domain 532 573 ! 533 boundary = (connectionsize+nb_connection_pts)*irafx + nbghostcellsfine + 1 534 CALL smooth_topo(G1%gdepw_ps(boundary:nxfinboundary+1,boundary:nyfinboundary+1),nbiter) 535 G1%bathy_meter = G1%gdepw_ps 574 ! Chanut: smoothing everywhere then discard result in connection zone 575 CALL smooth_topo(G1%gdepw_ps(1:nxfin,1:nyfin),nbiter) 576 WHERE (G1%wgt(:,:)==0.) G1%bathy_meter(:,:) = G1%gdepw_ps(:,:) 577 ! boundary = (connectionsize+nb_connection_pts)*irafx + nbghostcellsfine + 1 578 ! CALL smooth_topo(G1%gdepw_ps(boundary:nxfinboundary+1,boundary:nyfinboundary+1),nbiter) 579 ! G1%bathy_meter = G1%gdepw_ps 536 580 ENDIF 537 581 … … 578 622 ENDIF 579 623 ! 624 ! Chanut: Compute partial step bathymetry once more 625 CALL get_partial_steps(G1) ! compute gdepw_ps for G1 626 580 627 IF(bathy_update) CALL Update_Parent_Bathy( G0,G1 ) 581 628 ! 
utils/tools/NESTING/src/agrif_readwrite.f90
r9149 r9628 460 460 CALL Write_Ncdf_var('nav_lat' ,dimnames,name,Grid%nav_lat ,'float') 461 461 CALL Write_Ncdf_var(parent_batmet_name,dimnames,name,Grid%bathy_meter,'float') 462 CALL Write_Ncdf_var('weight' ,dimnames,name,Grid%wgt ,'float') 462 463 ! 463 464 CALL Copy_Ncdf_att('nav_lon' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon)) 
utils/tools/NESTING/src/agrif_types.f90
r9166 r9628 22 22 REAL*8, DIMENSION(:,:), POINTER :: bathy_level => NULL() 23 23 REAL*8, DIMENSION(:,:), POINTER :: bathy_meter => NULL() 24 REAL*8, DIMENSION(:,:), POINTER :: wgt => NULL() 24 25 REAL*8, DIMENSION(:,:,:),POINTER :: fmask,umask,vmask,tmask => NULL() 25 26 REAL*8, DIMENSION(:,:,:),POINTER :: e3t_ps,e3w_ps,gdept_ps,gdepwps => NULL()
Note: See TracChangeset
for help on using the changeset viewer.