Changeset 10027 for utils/tools/NESTING
- Timestamp:
- 2018-08-02T17:08:17+02:00 (6 years ago)
- Location:
- utils/tools/NESTING/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/NESTING/src/agrif_create_bathy.f90
r10025 r10027 40 40 ! variables declaration 41 41 ! 42 CHARACTER(len=80) :: namelistname 43 CHARACTER*100 :: Childmeter_file,Childlevel_file,Child_coordinates,child_ps, Child_domcfg 44 LOGICAL :: identical_grids 45 INTEGER :: i,j,num_links,nb,nbadd,status,narg,iargc 46 INTEGER :: jpj,jpi,pos,pos2 47 LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL() 48 INTEGER,DIMENSION(:,:),ALLOCATABLE :: mask_oce,trouble_points 49 INTEGER,DIMENSION(:) ,POINTER :: src_add,dst_add => NULL() 50 REAL*8, DIMENSION(:,:),POINTER :: matrix,interpdata => NULL() 51 REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant => NULL() 52 REAL*8, DIMENSION(:,:),ALLOCATABLE :: bathy_test,vardep,glamhr,gphihr 53 REAL*8, DIMENSION(:) ,ALLOCATABLE :: vardep1d 54 REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps_interp => NULL() 55 REAL*8, DIMENSION(:,:),POINTER :: save_gdepw,rx,ry,maskedtopo 56 REAL*8 :: Cell_lonmin,Cell_lonmax,Cell_latmin,Cell_latmax,wghts 57 LOGICAL :: Pacifique = .FALSE. 58 INTEGER :: boundary,xpos,ypos,iimin,iimax,jjmax,jjmin 59 INTEGER :: nxhr,nyhr,ji,jj,nbiter 60 INTEGER :: ipt,jpt,iloc,jloc 61 INTEGER, DIMENSION(2) :: i_min,i_max,j_min,j_max 42 CHARACTER(len=80) :: namelistname 43 CHARACTER*100 :: Childmeter_file,Childlevel_file,Child_coordinates,child_ps, Child_domcfg 44 LOGICAL :: identical_grids 45 INTEGER :: nbadd,status,narg,iargc 46 INTEGER :: jpj,jpi 47 LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL() 48 INTEGER,DIMENSION(:,:),ALLOCATABLE :: mask_oce,trouble_points 49 INTEGER,DIMENSION(:) ,POINTER :: src_add,dst_add => NULL() 50 REAL*8, DIMENSION(:,:),POINTER :: matrix,interpdata => NULL() 51 REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant => NULL() 52 REAL*8, DIMENSION(:,:),ALLOCATABLE :: bathy_test,vardep 53 REAL*8, DIMENSION(:) ,ALLOCATABLE :: vardep1d 54 REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps_interp => NULL() 55 REAL*8 :: Cell_lonmin,Cell_lonmax,Cell_latmin,Cell_latmax,wghts 56 LOGICAL :: Pacifique = .FALSE. 57 INTEGER :: boundary,iimin,iimax,jjmax,jjmin 58 INTEGER :: nxhr,nyhr,nxyhr,ji,jj,nbiter 62 59 63 60 TYPE(Coordinates) :: G0,G1 … … 155 152 ! 156 153 ! Check errors in bathy 157 DO j =1,nyfin158 DO i=1,nxfin159 IF (G1%bathy_level( i,j).LT.0.) THEN160 PRINT *,'error in ', i,j,G1%bathy_level(i,j)154 DO jj=1,nyfin 155 DO ji=1,nxfin 156 IF (G1%bathy_level(ji,jj).LT.0.) THEN 157 PRINT *,'error in ',ji,jj,G1%bathy_level(ji,jj) 161 158 STOP 162 159 ENDIF … … 178 175 DO WHILE (nbadd.NE.0) 179 176 nbadd = 0 180 DO j =2,nyfin-1181 DO i=2,nxfin-1182 IF (G1%bathy_level( i,j).GT.0.) THEN183 IF (MAX(bathy_test( i,j+1),bathy_test(i,j-1),bathy_test(i-1,j),bathy_test(i+1,j)).EQ.1) THEN184 IF (bathy_test( i,j).NE.1.) nbadd = nbadd + 1185 bathy_test( i,j)=1.177 DO jj=2,nyfin-1 178 DO ji=2,nxfin-1 179 IF (G1%bathy_level(ji,jj).GT.0.) THEN 180 IF (MAX(bathy_test(ji,jj+1),bathy_test(ji,jj-1),bathy_test(ji-1,jj),bathy_test(ji+1,jj)).EQ.1) THEN 181 IF (bathy_test(ji,jj).NE.1.) nbadd = nbadd + 1 182 bathy_test(ji,jj)=1. 186 183 ENDIF 187 184 ENDIF … … 264 261 trouble_points(:,:) = 0 265 262 ! 266 DO jj = 2, nyfin267 DO ji = 2, nxfin263 DO jj = 2, nyfin 264 DO ji = 2, nxfin 268 265 ! 269 266 ! fine grid cell extension … … 325 322 ENDWHERE 326 323 ! 327 IF( SUM(mask_oce) < 0.5*(nxhr*nyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0 324 nxyhr = nxhr*nyhr 325 IF( SUM(mask_oce) < 0.5*(nxyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0 328 326 G1%bathy_meter(ji,jj) = 0. 329 327 ELSE … … 331 329 G1%bathy_meter(ji,jj) = SUM( vardep(:,:) * mask_oce(:,:) ) / SUM( mask_oce(:,:) ) 332 330 ELSE ! Median average 333 vardep(:,:) = vardep(:,:) * mask_oce(:,:) - 100000 * ( 1 - mask_oce(:,:))334 ALLOCATE(vardep1d(nxhr*nyhr))335 vardep1d = RESHAPE(vardep,(/ nxhr*nyhr /))336 CALL ssort(vardep1d,nxhr*nyhr)331 ALLOCATE(vardep1d(nxyhr)) 332 vardep1d = RESHAPE(vardep,(/ nxyhr /) ) 333 !!CALL ssort(vardep1d,nxyhr) 334 CALL quicksort(vardep1d,1,nxyhr) 337 335 ! 338 336 ! Calculate median 339 IF (MOD( SUM(mask_oce),2) .NE. 0) THEN340 G1%bathy_meter(ji,jj) = vardep1d( SUM(mask_oce)/2 + 1 )337 IF (MOD(nxyhr,2) .NE. 0) THEN 338 G1%bathy_meter(ji,jj) = vardep1d( nxyhr/2 + 1 ) 341 339 ELSE 342 G1%bathy_meter(ji,jj) = 0.5 * ( vardep1d( SUM(mask_oce)/2) + vardep1d(SUM(mask_oce)/2+1) )340 G1%bathy_meter(ji,jj) = 0.5 * ( vardep1d(nxyhr/2) + vardep1d(nxyhr/2+1) ) 343 341 END IF 344 342 DEALLOCATE(vardep1d) … … 572 570 DO WHILE (nbadd.NE.0) 573 571 nbadd = 0 574 DO j =2,nyfin-1575 DO i=2,nxfin-1576 IF (G1%bathy_meter( i,j).GT.0.) THEN577 IF (MAX(bathy_test( i,j+1),bathy_test(i,j-1),bathy_test(i-1,j),bathy_test(i+1,j)).EQ.1) THEN578 IF (bathy_test( i,j).NE.1.) nbadd = nbadd + 1579 bathy_test( i,j)=1.572 DO jj=2,nyfin-1 573 DO ji=2,nxfin-1 574 IF (G1%bathy_meter(ji,jj).GT.0.) THEN 575 IF (MAX(bathy_test(ji,jj+1),bathy_test(ji,jj-1),bathy_test(ji-1,jj),bathy_test(ji+1,jj)).EQ.1) THEN 576 IF (bathy_test(ji,jj).NE.1.) nbadd = nbadd + 1 577 bathy_test(ji,jj)=1. 580 578 ENDIF 581 579 -
utils/tools/NESTING/src/agrif_modutil.f90
r2143 r10027 49 49 END SUBROUTINE ssort 50 50 ! 51 !*********************************************************** 52 ! --- quicksort --- 53 ! Author: t-nissie 54 ! License: GPLv3 55 ! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea 56 !*********************************************************** 57 RECURSIVE SUBROUTINE quicksort(var, first, last) 58 IMPLICIT NONE 59 60 REAL*8, DIMENSION(:), INTENT(inout) :: var 61 INTEGER, INTENT(in) :: first, last 62 REAL*8 :: x, t 63 INTEGER :: ji, jj 64 65 x = var( (first+last) / 2 ) 66 ji = first 67 jj = last 68 DO 69 DO WHILE (var(ji) < x) 70 ji=ji+1 71 END DO 72 DO WHILE (x < var(jj)) 73 jj=jj-1 74 END DO 75 IF (ji >= jj) EXIT 76 t = var(ji); var(ji) = var(jj); var(jj) = t 77 ji=ji+1 78 jj=jj-1 79 END DO 80 IF (first < ji-1) CALL quicksort(var, first, ji-1) 81 IF (jj+1 < last) CALL quicksort(var, jj+1, last) 82 END SUBROUTINE quicksort 83 51 84 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 52 85 !************************************************************************
Note: See TracChangeset
for help on using the changeset viewer.