Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

agrif_create_bathy.f90

Last change on this file was 12273, checked in by clem, 4 years ago
debug: make sure bathymetry at the boundaries of the child domain is the same as the parent's one when using the same bathymetry for both parent and child grids
Property svn:keywords set to `Id`
File size: 20.1 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	!
8	PROGRAM 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 ! clem: no, do it even when there is no new topo
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	!
502	END PROGRAM create_bathy
503
504

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: