source: utils/tools/NESTING/src/agrif_create_bathy.f90 @ 12264

Last change on this file since 12264 was 12264, checked in by clem, 10 months ago

finishing cleaning the nesting tools (as far as I could). I will stop there

  • Property svn:keywords set to Id
File size: 20.3 KB
Line 
1!************************************************************************
2! Fortran 95 OPA Nesting tools                  *
3!                          *
4!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)   *
5!                        Laurent Debreu (Laurent.Debreu@imag.fr)  *
6!************************************************************************
7!
8PROGRAM create_bathy
9  !
10  USE NETCDF
11  USE bilinear_interp
12  USE agrif_readwrite
13  USE agrif_partial_steps
14  USE agrif_connect_topo
15  USE agrif_interpolation
16  !
17  IMPLICIT NONE
18  !
19  !************************************************************************
20  !                           *
21  ! PROGRAM  CREATE_BATHY                 *
22  !                           *
23  ! program to implement bathymetry interpolation to generate     *
24  ! child grid bathymetry file                  *
25  !                           *
26  ! various options :                     *
27  !                           *
28  ! 1- Interpolation directly from parent bathymetry file (z-coord)  *
29  ! 2- Use new topo file in meters (for example etopo)      *
30  !                           *
31  ! vertical coordinates permitted : z-coord and partial steps    *
32  ! sigma coordinates is not yet implemented          *
33  !                           *
34  !Interpolation is carried out using bilinear interpolation      *
35  !routine from SCRIP package or median average          *     
36  !                           *
37  !http://climate.lanl.gov/Software/SCRIP/            *
38  !************************************************************************
39  !
40  ! variables declaration
41  !     
42  CHARACTER(len=80) ::   namelistname
43  CHARACTER*100     ::   child_coordinates, child_level, child_meter, 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
59
60  TYPE(Coordinates) :: G0,G1 
61  !     
62  narg = iargc()     
63  IF (narg == 0) THEN
64     namelistname = 'namelist.input'
65  ELSE
66     CALL getarg(1,namelistname)
67  ENDIF
68  !
69  ! read input file (namelist.input)
70  CALL read_namelist(namelistname)
71
72  ! if level or meter name is missing
73  IF( TRIM(parent_level_name) == '' )   parent_level_name='mbathy'
74  IF( TRIM(parent_meter_name) == '' )   parent_meter_name='Bathymetry'
75
76  ! define names of child grid files
77  CALL set_child_name(parent_coordinate_file,child_coordinates) 
78  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,child_level)           
79  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,child_meter)
80  IF( TRIM(parent_domcfg_out)  /= '' )   CALL set_child_name(parent_domcfg_out,child_domcfg) 
81  !
82  IF( TRIM(parent_bathy_level) == '' .AND. TRIM(parent_bathy_meter) == '') THEN
83     WRITE(*,*) 'ERROR ***** one needs at least to define parent_bathy_level or parent_bathy_meter ...'
84     STOP
85  ENDIF
86  !
87  ! read fine and coarse grids coordinates file
88  status = Read_Coordinates(TRIM(parent_coordinate_file),G0)
89  status = Read_Coordinates(TRIM(child_coordinates),G1,Pacifique)
90  !
91  ! check error in size
92  IF( imax > SIZE(G0%nav_lon,1) .OR. jmax > SIZE(G0%nav_lon,2) .OR. imax <= imin .OR. jmax <= jmin ) THEN
93     WRITE(*,*) 'ERROR ***** bad child grid definition ...'
94     WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
95     STOP
96  ENDIF
97  IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
98     WRITE(*,*) 'ERROR ***** bad child coordinates file ...'
99     WRITE(*,*) 'please check that child coordinates file has been created with the same namelist'
100     STOP
101  ENDIF
102  !
103  ! read bathymetry data set => G0%bathy_meter
104  IF( new_topo ) THEN                                       ! read G0%bathy_meter (on a reduced grid) and G1 coordinates
105     DEALLOCATE( G0%nav_lon, G0%nav_lat )
106     status = read_bathy_coord(TRIM(elevation_database),G0,G1,Pacifique)
107  ELSE                                                      ! read G0%bathy_meter (on the global grid)
108     IF( TRIM(parent_bathy_meter) /= '') THEN
109        status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
110     ELSE
111        status = Read_bathy_level(TRIM(parent_bathy_level),G0)
112        CALL levels_to_meter(G0)
113     ENDIF     
114     ! change longitudes (from -180:180 to 0:360)
115     IF(Pacifique) THEN
116        WHERE(G0%nav_lon < 0.001)   G0%nav_lon = G0%nav_lon + 360.
117     ENDIF
118  ENDIF
119  !
120  ! 1st allocation of child grid bathy
121  ALLOCATE(G1%bathy_meter(nxfin,nyfin))
122  G1%bathy_meter(:,:)=0.
123
124  ! check grids: if identical then do not interpolate
125  identical_grids = .FALSE.
126 
127  IF(  SIZE(G0%nav_lat,1) == SIZE(G1%nav_lat,1) .AND. SIZE(G0%nav_lat,2) == SIZE(G1%nav_lat,2) .AND. &
128     & SIZE(G0%nav_lon,1) == SIZE(G1%nav_lon,1) .AND. SIZE(G0%nav_lon,2) == SIZE(G1%nav_lon,2) ) THEN
129     IF(  MAXVAL( ABS(G0%nav_lat(:,:)- G1%nav_lat(:,:)) ) < 0.0001 .AND. &
130        & MAXVAL( ABS(G0%nav_lon(:,:)- G1%nav_lon(:,:)) ) < 0.0001 ) THEN
131        WRITE(*,*) ''
132        WRITE(*,*) 'same grid between parent and child domains => NO INTERPOLATION'
133        WRITE(*,*) ''
134        G1%bathy_meter = G0%bathy_meter
135        identical_grids = .TRUE.
136     ENDIF
137  ENDIF
138 
139  IF( .NOT.new_topo )   type_bathy_interp = 2   ! only one which works
140  !
141  !
142  ! what type of interpolation for bathymetry
143  IF( type_bathy_interp == 0 ) THEN
144     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Arithmetic average ...'
145  ELSE IF( type_bathy_interp == 1 ) THEN
146     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Median average ...'
147  ELSE IF( type_bathy_interp == 2 ) THEN     
148     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Bilinear interpolation ...'
149  ELSE     
150     WRITE(*,*) 'bad value for type_bathy_interp variable ( must be 0, 1 or 2 )'
151     STOP
152  ENDIF
153  !
154  !
155  ! ---------------------------------------------------------------------------------
156  ! ===                 Bathymetry of the fine grid (step1)                       ===
157  ! ---------------------------------------------------------------------------------
158  ! ==> It gives G1%bathy_meter from G0%bathy_meter
159  ! ---------------------------------------------------------------------------------
160 
161  ! === Here: G0 is the grid associated with the new topography (as gebco or etopo) ===
162 
163  IF( .NOT. identical_grids ) THEN
164     !                                                               ! -----------------------------
165     IF( type_bathy_interp == 0 .OR. type_bathy_interp == 1 ) THEN   ! arithmetic or median averages
166        !                                                            ! -----------------------------
167        ALLOCATE(trouble_points(nxfin,nyfin))
168        trouble_points(:,:) = 0
169        !                       
170        DO jj = 2, nyfin
171           DO ji = 2, nxfin
172              !       
173              ! fine grid cell extension               
174              Cell_lonmin = MIN(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
175              Cell_lonmax = MAX(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
176              Cell_latmin = MIN(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj))
177              Cell_latmax = MAX(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj)) 
178              !               
179              ! look for points in G0 (bathy dataset) contained in the fine grid cells 
180              iimin = 1
181              DO WHILE( G0%nav_lon(iimin,1) < Cell_lonmin ) 
182                 iimin = iimin + 1
183              ENDDO
184              !               
185              jjmin = 1
186              DO WHILE( G0%nav_lat(iimin,jjmin) < Cell_latmin ) 
187                 jjmin = jjmin + 1
188              ENDDO
189              !               
190              iimax = iimin 
191              DO WHILE( G0%nav_lon(iimax,1) <= Cell_lonmax ) 
192                 iimax = iimax + 1
193                 iimax = MIN( iimax,SIZE(G0%bathy_meter,1))
194              ENDDO
195              !                               
196              jjmax = jjmin 
197              DO WHILE( G0%nav_lat(iimax,jjmax) <= Cell_latmax ) 
198                 jjmax = jjmax + 1
199                 jjmax = MIN( jjmax,SIZE(G0%bathy_meter,2))
200              ENDDO
201              !
202              IF( ln_agrif_domain ) THEN
203                 iimax = iimax-1
204                 jjmax = jjmax-1
205              ELSE
206                 iimax = MAX(iimin,iimax-1)
207                 jjmax = MAX(jjmin,jjmax-1)
208              ENDIF
209              !               
210              iimin = MAX( iimin,1 )
211              jjmin = MAX( jjmin,1 )
212              iimax = MIN( iimax,SIZE(G0%bathy_meter,1))
213              jjmax = MIN( jjmax,SIZE(G0%bathy_meter,2))
214
215              nxhr = iimax - iimin + 1
216              nyhr = jjmax - jjmin + 1                   
217
218              IF( nxhr == 0 .OR. nyhr == 0 ) THEN
219                 !
220                 trouble_points(ji,jj) = 1
221                 !
222              ELSE
223                 !
224                 ALLOCATE( vardep(nxhr,nyhr), mask_oce(nxhr,nyhr) )
225                 vardep(:,:) = G0%bathy_meter(iimin:iimax,jjmin:jjmax)
226                 !
227                 WHERE( vardep(:,:) .GT. 0. )   ;   mask_oce = 1 ;
228                 ELSEWHERE                      ;   mask_oce = 0 ;
229                 ENDWHERE
230                 !
231                 nxyhr = nxhr*nyhr
232                 IF( SUM(mask_oce) < 0.5*(nxyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0
233                    G1%bathy_meter(ji,jj) = 0.
234                 ELSE
235                    IF( type_bathy_interp == 0 ) THEN     ! Arithmetic average
236                       G1%bathy_meter(ji,jj) = SUM( vardep(:,:) * mask_oce(:,:) ) / SUM( mask_oce(:,:) )
237                    ELSE                                  ! Median average
238                       ALLOCATE(vardep1d(nxyhr))
239                       vardep1d = RESHAPE(vardep,(/ nxyhr /) )
240                       !!CALL ssort(vardep1d,nxyhr)
241                       CALL quicksort(vardep1d,1,nxyhr)
242                       !
243                       ! Calculate median
244                       IF (MOD(nxyhr,2) .NE. 0) THEN
245                          G1%bathy_meter(ji,jj) = vardep1d( nxyhr/2 + 1 )
246                       ELSE
247                          G1%bathy_meter(ji,jj) = 0.5 * ( vardep1d(nxyhr/2) + vardep1d(nxyhr/2+1) )
248                       END IF
249                       DEALLOCATE(vardep1d)   
250                    ENDIF
251                 ENDIF
252                 DEALLOCATE (mask_oce,vardep)
253                 !
254              ENDIF
255           ENDDO
256        ENDDO
257
258        IF( SUM( trouble_points ) > 0 ) THEN
259           PRINT*,'too much empty cells, proceed to bilinear interpolation'
260           type_bathy_interp = 2
261        ENDIF
262
263        DEALLOCATE(trouble_points)
264
265     ENDIF
266     !                                                       ! -----------------------------
267     IF( type_bathy_interp == 2) THEN                        ! Bilinear interpolation
268        !                                                    ! -----------------------------
269
270        ALLOCATE(masksrc(SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
271        ALLOCATE(bathy_test(nxfin,nyfin))
272        !
273        WHERE(G0%bathy_meter.LE.0)   ;   masksrc = .FALSE.   ;
274        ELSEWHERE                    ;   masksrc = .TRUE.    ;
275        END WHERE
276        !           
277        ! compute remapping matrix thanks to SCRIP package           
278        CALL get_remap_matrix(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
279        CALL make_remap(G0%bathy_meter,bathy_test,nxfin,nyfin,matrix,src_add,dst_add) 
280        !                                 
281        G1%bathy_meter = bathy_test               
282        !           
283        DEALLOCATE(masksrc)
284        DEALLOCATE(bathy_test) 
285
286     ENDIF
287     !           
288  ENDIF ! not identical grids
289  ! ---
290  ! At this stage bathymetry in meters has already been interpolated on fine grid
291  !                    => G1%bathy_meter(nxfin,nyfin)
292  !
293  ! Also G0 was the grid from the new bathymetry data set (etopo, gebco...) and not the coarse grid
294  ! ---
295  !
296  ! ---------------------------------------------------------------------------------
297  ! ===                 Bathymetry of the fine grid (step2)                       ===
298  ! ---------------------------------------------------------------------------------
299  ! ==> It gives an update of G1%bathy_meter and G1%bathy_level
300  ! ---------------------------------------------------------------------------------
301  ! From here on: G0 is the coarse grid
302  !
303  ! Coarse grid bathymetry : G0%bathy_meter (on the global grid)
304  IF( TRIM(parent_bathy_meter) /= '') THEN
305     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
306  ELSE
307     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
308     CALL levels_to_meter(G0)
309  ENDIF
310
311  ! Coarse grid coordinatees : G0 coordinates
312  DEALLOCATE(G0%nav_lat,G0%nav_lon)
313  status = Read_coordinates(TRIM(parent_coordinate_file),G0)
314
315  ! allocate temporary arrays                 
316  IF (.NOT.ASSOCIATED(G0%gdepw_ps))       ALLOCATE(G0%gdepw_ps    (SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
317  IF (.NOT.ASSOCIATED(G1%gdepw_ps))       ALLOCATE(G1%gdepw_ps    (SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
318  IF (.NOT.ASSOCIATED(gdepw_ps_interp))   ALLOCATE(gdepw_ps_interp(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
319  !                       
320  IF( ln_agrif_domain ) THEN
321     boundary = npt_copy*irafx + nbghostcellsfine + 1
322  ELSE
323     boundary = npt_copy*irafx
324  ENDIF
325  !
326  ! compute G0%gdepw_ps and G1%gdepw_ps
327  CALL get_partial_steps(G0) 
328  CALL get_partial_steps(G1)
329  CALL bathymetry_control(G0%Bathy_level)
330 
331  ! ---------------------------------------
332  ! Bathymetry at the boundaries (npt_copy)                     
333  ! ---------------------------------------
334  ! 1st step: interpolate coarse bathy on the fine grid (using partial steps or not)
335  IF( ln_agrif_domain ) THEN                   
336     CALL Check_interp(G0,gdepw_ps_interp)
337  ELSE
338     gdepw_ps_interp = 0. * G1%gdepw_ps
339     !!CALL agrif_interp(G0%gdepw_ps,gdepw_ps_interp,'T')
340     CALL init_constant_bathy(G0%gdepw_ps,gdepw_ps_interp)
341  ENDIF
342
343  IF (.NOT.ASSOCIATED(G1%wgt))   ALLOCATE(G1%wgt(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
344  G1%wgt(:,:) = 0.
345  IF ((.NOT.ASSOCIATED(G0%wgt)).AND.bathy_update) THEN
346     ALLOCATE(G0%wgt(SIZE(G0%nav_lat,1),SIZE(G0%nav_lat,2)))
347     G0%wgt(:,:) = 0.
348  ENDIF
349  !
350  IF( new_topo ) THEN
351     ! 2nd step: copy parent bathymetry at the boundaries
352     DO jj=1,nyfin   ! West and East
353        IF ( gdepw_ps_interp(nbghostcellsfine+1,jj) > 0. ) THEN
354           G1%gdepw_ps(1:boundary,jj) = gdepw_ps_interp(1:boundary,jj) 
355           G1%wgt(1:boundary,jj) = 1.
356        ELSE
357           G1%gdepw_ps(1:nbghostcellsfine+1,jj)=0. 
358        ENDIF
359        !
360        IF ( gdepw_ps_interp(nxfin-nbghostcellsfine,jj) > 0.) THEN
361           G1%gdepw_ps(nxfin-boundary+1:nxfin,jj)=gdepw_ps_interp(nxfin-boundary+1:nxfin,jj)
362           G1%wgt(nxfin-boundary+1:nxfin,jj) = 1.
363        ELSE
364           G1%gdepw_ps(nxfin-nbghostcellsfine:nxfin,jj) = 0.
365        ENDIF
366     END DO
367     !
368     DO ji=1,nxfin    ! South and North
369        IF (gdepw_ps_interp(ji,nbghostcellsfine+1)>0.) THEN
370           G1%gdepw_ps(ji,1:boundary) = gdepw_ps_interp(ji,1:boundary)
371           G1%wgt(ji,1:boundary) = 1.
372        ELSE
373           G1%gdepw_ps(ji,1:nbghostcellsfine+1)=0. 
374        ENDIF
375        !
376        IF (gdepw_ps_interp(ji,nyfin-nbghostcellsfine)>0.) THEN
377           G1%gdepw_ps(ji,nyfin-boundary+1:nyfin)=gdepw_ps_interp(ji,nyfin-boundary+1:nyfin)
378           G1%wgt(ji,nyfin-boundary+1:nyfin) = 1.
379        ELSE
380           G1%gdepw_ps(ji,nyfin-nbghostcellsfine:nyfin) = 0.
381        ENDIF
382     END DO
383     !
384     !clem: recalculate interpolation everywhere before linear connection (useless to me??)
385     IF( ln_agrif_domain ) THEN               
386        gdepw_ps_interp = 0.
387        CALL Check_interp(G0,gdepw_ps_interp)
388     ENDIF
389     !
390     ! -------------------------------------------------------
391     ! Bathymetry between boundaries and interior (npt_connect)                 
392     ! --------------------------------------------------------
393     ! Make linear connection (on npt_connect*irafx points) between the boundaries and the interior
394     IF( ln_agrif_domain ) THEN
395        boundary = (npt_copy + npt_connect)*irafx + nbghostcellsfine + 1
396     ELSE
397        boundary = (npt_copy + npt_connect)*irafx
398     ENDIF
399
400     IF( npt_connect > 0 ) THEN
401        WRITE(*,*) ' linear connection on ',npt_connect,'coarse grid points'
402
403        wghts = 1.
404        DO ji = boundary - npt_connect*irafx + 1 , boundary
405           wghts = wghts - (1. / (npt_connect*irafx + 1. ) )
406           DO jj=1,nyfin
407              IF (G1%gdepw_ps(nbghostcellsfine+1,jj) > 0.)       G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj)) 
408           END DO
409        END DO
410
411        wghts = 1.
412        DO ji = nxfin - (boundary - npt_connect*irafx), nxfin - boundary +1 , -1
413           wghts = wghts - (1. / (npt_connect*irafx + 1. ) )
414           DO jj=1,nyfin
415              IF (G1%gdepw_ps(nxfin-nbghostcellsfine,jj) > 0.)   G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
416           END DO
417        END DO
418
419        wghts = 1.
420        DO jj = boundary - npt_connect*irafy + 1 , boundary
421           wghts = wghts - (1. / (npt_connect*irafy + 1. ) )
422           DO ji=1,nxfin
423              IF (G1%gdepw_ps(ji,nbghostcellsfine+1) > 0.)       G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
424           END DO
425        END DO
426
427        wghts = 1.
428        DO jj = nyfin - (boundary - npt_connect*irafy) , nyfin - boundary +1, -1
429           wghts = wghts - (1. / (npt_connect*irafy + 1. ) )
430           DO ji=1,nxfin
431              IF (G1%gdepw_ps(ji,nyfin-nbghostcellsfine) > 0.)   G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
432           END DO
433        END DO
434        IF (.NOT.identical_grids) THEN
435           G1%gdepw_ps(:,:) = (1.-G1%wgt(:,:)) * G1%gdepw_ps(:,:) + gdepw_ps_interp(:,:)*G1%wgt(:,:)
436        ENDIF
437
438     ENDIF
439  ENDIF
440
441  ! replace G1%bathy_meter by G1%gdepw_ps
442  G1%bathy_meter = G1%gdepw_ps
443  !                     
444  ! --------------------
445  ! Bathymetry smoothing                 
446  ! --------------------
447  IF( smoothing .AND. (.NOT.identical_grids) ) THEN
448     ! Chanut: smoothing everywhere then discard result in connection zone
449     CALL smooth_topo(G1%gdepw_ps(:,:),nbiter)
450     WHERE (G1%wgt(:,:)==0.) G1%bathy_meter(:,:) = G1%gdepw_ps(:,:)
451  ELSE
452     WRITE(*,*) 'No smoothing process only connection is carried out'
453  ENDIF
454  !
455  ! ------------------
456  ! Remove closed seas
457  ! ------------------
458  IF (removeclosedseas) THEN
459     ALLOCATE(bathy_test(nxfin,nyfin))
460     bathy_test=0.
461     WHERE (G1%bathy_meter(1,:)    .GT.0.)   bathy_test(1,:)=1
462     WHERE (G1%bathy_meter(nxfin,:).GT.0.)   bathy_test(nxfin,:)=1
463     WHERE (G1%bathy_meter(:,1)    .GT.0.)   bathy_test(:,1)=1
464     WHERE (G1%bathy_meter(:,nyfin).GT.0.)   bathy_test(:,nyfin)=1
465
466     nbadd = 1
467     DO WHILE (nbadd.NE.0)
468        nbadd = 0
469        DO jj=2,nyfin-1
470           DO ji=2,nxfin-1
471              IF (G1%bathy_meter(ji,jj).GT.0.) THEN
472                 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
473                    IF (bathy_test(ji,jj).NE.1.) nbadd = nbadd + 1
474                    bathy_test(ji,jj)=1.
475                 ENDIF
476
477              ENDIF
478           ENDDO
479        ENDDO
480     ENDDO
481     WHERE (bathy_test.EQ.0.)   G1%bathy_meter = 0.
482     DEALLOCATE(bathy_test)
483  ENDIF
484  !
485  CALL get_partial_steps(G1)  ! recompute bathy_level and gdepw_ps for G1 (and correct bathy_meter)
486  !
487  ! update parent grid
488  IF(bathy_update) THEN
489     CALL Update_Parent_Bathy( G0,G1 ) 
490     status = Write_Bathy_meter(TRIM(parent_bathy_meter_updated),G0)
491     status = write_domcfg(TRIM(parent_domcfg_updated),G0)
492  ENDIF
493  !
494  ! store interpolation result in output file
495  IF( TRIM(parent_bathy_level) /= '' )   status = Write_Bathy_level(TRIM(child_level),G1)
496  IF( TRIM(parent_bathy_meter) /= '' )   status = Write_Bathy_meter(TRIM(child_meter),G1)
497  IF( TRIM(parent_domcfg_out)  /= '' )   status = write_domcfg(TRIM(child_domcfg),G1)
498  !
499  WRITE(*,*) '****** Bathymetry successfully created ******'
500  STOP
501  !
502END PROGRAM create_bathy
503
504
Note: See TracBrowser for help on using the repository browser.