FMS  2025.04
Flexible Modeling System
topography.inc
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 !> @defgroup topography_mod topography_mod
19 !> @ingroup topography
20 !> @brief Routines for creating land surface topography fields and land-water masks
21 !! for latitude-longitude grids.
22 !> @author Bruce Wyman
23 !!
24 !! This module generates realistic mountains and land-water masks
25 !! on a specified latitude-longitude grid by interpolating from the
26 !! 1/6 degree Navy mean topography and percent water data sets.
27 !! The fields that can be generated are mean and standard deviation
28 !! of topography within the specified grid boxes; and land-ocean (or
29 !! water) mask and land-ocean (or water) fractional area.
30 !!
31 !! The interpolation scheme conserves the area-weighted average
32 !! of the input data by using module horiz_interp.
33 !!
34 !! The interfaces get_gaussian_topog and gaussian_topog_init are documented
35 !! in @ref gaussian_topog_mod
36 
37 !#######################################################################
38 
39  !> @brief Returns a "realistic" mean surface height field.
40  !!
41  !> Returns realistic mountains on a latitude-longtude grid.
42  !! The returned field is the mean topography for the given grid boxes.
43  !! Computed using a conserving area-weighted interpolation.
44  !! The current input data set is the 1/6 degree Navy mean topography.
45  !!
46  !! @returns A logical value of true is returned if the surface height field was successfully
47  !! created. A value of false may be returned if the input topography data set was not readable.
48  !!
49  !! @throws FATAL, shape(zmean) is not equal to (/size(blon)-1,size(blat)-1/)
50  !! Check the input grid size and output field size.
51 
52  function get_topog_mean_1d_(blon, blat, zmean)
53 
54  real(kind=fms_top_kind_), intent(in), dimension(:) :: blon !< Longitude (radians) at grid box boundaries
55  real(kind=fms_top_kind_), intent(in), dimension(:) :: blat !< Latitude (radians) at grid box boundaries
56  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: zmean !< Mean surface height(meters). Size must be
57  !! size(blon)-1 by size(blat)-1
58  logical :: GET_TOPOG_MEAN_1D_
59  integer, parameter :: lkind = fms_top_kind_
60 
61 !-----------------------------------------------------------------------
62  if (.not. module_is_initialized) call topography_init()
63 
64  if ( any(shape(zmean(:,:)) /= (/size(blon(:))-1,size(blat(:))-1/)) ) &
65  call error_mesg('get_topog_mean_1d','shape(zmean) is not&
66  & equal to (/size(blon)-1,size(blat)-1/))', fatal)
67 
68  get_topog_mean_1d_ = open_topog_file()
69 
70  if (get_topog_mean_1d_) call interp_topog(blon, blat, zmean)
71 
72 !-----------------------------------------------------------------------
73 
74  end function get_topog_mean_1d_
75 
76 !############################################################
77 
78  function get_topog_mean_2d_(blon, blat, zmean)
79 
80  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blon, blat
81  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: zmean
82  logical :: GET_TOPOG_MEAN_2D_
83  integer, parameter :: lkind = fms_top_kind_
84 !-----------------------------------------------------------------------
85  if (.not. module_is_initialized) call topography_init()
86 
87  if ( any(shape(zmean(:,:)) /= (/size(blon,1)-1,size(blon,2)-1/)) .or. &
88  any(shape(zmean(:,:)) /= (/size(blat,1)-1,size(blat,2)-1/)) ) &
89  call error_mesg('get_topog_mean_2d','shape(zmean) is not&
90  & equal to (/size(blon,1)-1,size(blon,2)-1/))', fatal)
91 
92  get_topog_mean_2d_ = open_topog_file()
93 
94  if (get_topog_mean_2d_) call interp_topog(blon, blat, zmean)
95 !-----------------------------------------------------------------------
96 
97  end function get_topog_mean_2d_
98 
99 !#######################################################################
100 
101  !> @brief Returns a standard deviation of higher resolution topography with
102  !! the given model grid boxes.
103  !!
104  !> Returns the standard deviation of the "finer" input topography data set,
105  !! currently the Navy 1/6 degree mean topography data, within the
106  !! boundaries of the given input grid.
107  !!
108  !! @returns A logical value of true if the output field was successfully created and false
109  !! if the input topography data set was not readable.
110  function get_topog_stdev_1d_(blon, blat, stdev)
111 
112  real(kind=fms_top_kind_), intent(in), dimension(:) :: blon !< Longitude (radians) at grid box boundaries
113  real(kind=fms_top_kind_), intent(in), dimension(:) :: blat !< Latitude (radians) at grid box boundaries
114  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: stdev !< The standard deviation of surface height (in
115  !! meters) within given input model grid boxes. Size must be
116  !! size(blon)-1 by size(blat)-1
117  logical :: GET_TOPOG_STDEV_1D_
118  integer, parameter :: lkind = fms_top_kind_
119 !-----------------------------------------------------------------------
120  if (.not. module_is_initialized) call topography_init()
121 
122  if ( any(shape(stdev(:,:)) /= (/size(blon(:))-1,size(blat(:))-1/)) ) &
123  call error_mesg('get_topog_stdev','shape(stdev) is not&
124  & equal to (/size(blon)-1,size(blat)-1/))', fatal)
125 
126  get_topog_stdev_1d_ = open_topog_file()
127 
128  if (get_topog_stdev_1d_) call interp_topog(blon, blat, &
129  stdev, flag=compute_stdev)
130 
131 !-----------------------------------------------------------------------
132 
133  end function get_topog_stdev_1d_
134 
135 !#######################################################################
136 
137  function get_topog_stdev_2d_(blon, blat, stdev)
138 
139  real(FMS_TOP_KIND_), intent(in), dimension(:,:) :: blon, blat
140  real(FMS_TOP_KIND_), intent(out), dimension(:,:) :: stdev
141  logical :: GET_TOPOG_STDEV_2D_
142  integer, parameter :: lkind = fms_top_kind_
143 !-----------------------------------------------------------------------
144  if (.not. module_is_initialized) call topography_init()
145 
146  if ( any(shape(stdev(:,:)) /= (/size(blon,1)-1,size(blon,2)-1/)) .or. &
147  any(shape(stdev(:,:)) /= (/size(blat,1)-1,size(blat,2)-1/)) ) &
148  call error_mesg('get_topog_stdev_2d','shape(stdev) is not&
149  & equal to (/size(blon,1)-1,size(blon,2)-1/))', fatal)
150 
151  get_topog_stdev_2d_ = open_topog_file()
152 
153  if (get_topog_stdev_2d_) call interp_topog(blon, blat, &
154  stdev, flag=compute_stdev)
155 !-----------------------------------------------------------------------
156 
157  end function get_topog_stdev_2d_
158 
159 !#######################################################################
160 
161  !> @brief Returns fractional area covered by ocean in a grid box.
162  !> @returns A logical value of true if the output field was successfully created. A value of false
163  !! may be returned if the Navy 1/6 degree percent water data set was not readable.
164  function get_ocean_frac_1d_(blon, blat, ocean_frac)
165 
166  real(FMS_TOP_KIND_), intent(in), dimension(:) :: blon !< Longitude (radians) at grid box boundaries
167  real(FMS_TOP_KIND_), intent(in), dimension(:) :: blat !< Latitude (radians) at grid box boundaries
168  real(FMS_TOP_KIND_), intent(out), dimension(:,:) :: ocean_frac !< The fractional amount (0-1) of ocean in a grid
169  !! box. The size must be size(blon)-1 by size(blat)-1
170  logical :: GET_OCEAN_FRAC_1D_
171  integer, parameter :: lkind = fms_top_kind_
172 !-----------------------------------------------------------------------
173  if (.not. module_is_initialized) call topography_init()
174 
175  if ( any(shape(ocean_frac(:,:)) /= (/size(blon(:))-1,size(blat(:))-1/)) ) &
176  call error_mesg('get_ocean_frac','shape(ocean_frac) is not&
177  & equal to (/size(blon)-1,size(blat)-1/))', fatal)
178 
179  get_ocean_frac_1d_ = open_water_file()
180  if(get_ocean_frac_1d_) call interp_water( blon, blat, &
181  ocean_frac, do_ocean=.true. )
182 
183 !-----------------------------------------------------------------------
184 
185  end function get_ocean_frac_1d_
186 
187 !#######################################################################
188 
189  function get_ocean_frac_2d_(blon, blat, ocean_frac)
190 
191  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blon, blat
192  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: ocean_frac
193  logical :: GET_OCEAN_FRAC_2D_
194  integer, parameter :: lkind = fms_top_kind_
195 !-----------------------------------------------------------------------
196  if (.not. module_is_initialized) call topography_init()
197 
198  if ( any(shape(ocean_frac(:,:)) /= (/size(blon,1)-1,size(blon,2)-1/)) .or. &
199  any(shape(ocean_frac(:,:)) /= (/size(blat,1)-1,size(blat,2)-1/)) ) &
200  call error_mesg('get_ocean_frac_2d','shape(ocean_frac) is not&
201  & equal to (/size(blon,1)-1,size(blon,2)-1/))', fatal)
202 
203  get_ocean_frac_2d_ = open_water_file()
204  if(get_ocean_frac_2d_) call interp_water( blon, blat, &
205  ocean_frac, do_ocean=.true. )
206 
207 !-----------------------------------------------------------------------
208 
209  end function get_ocean_frac_2d_
210 
211 !#######################################################################
212 
213  !> @brief Returns a land-ocean mask in a grid box.
214  !> @returns A logical value of true if the output field was successfully created. A value of false
215  !! may be returned if the Navy 1/6 degree percent water data set was not readable.
216  function get_ocean_mask_1d_(blon, blat, ocean_mask)
217 
218  real(kind=fms_top_kind_), intent(in), dimension(:) :: blon !< Longitude (radians) at grid box boundaries
219  real(kind=fms_top_kind_), intent(in), dimension(:) :: blat !< Latitude (radians) at grid box boundaries
220  logical, intent(out), dimension(:,:) :: ocean_mask !< Mask for ocean in a grid box.
221  !! The size must be size(blon)-1 by size(blat)-1
222  logical :: GET_OCEAN_MASK_1D_
223  real(kind=fms_top_kind_), dimension(size(ocean_mask,1),size(ocean_mask,2)) :: ocean_frac
224  integer, parameter :: lkind = fms_top_kind_
225 !-----------------------------------------------------------------------
226  if (.not. module_is_initialized) call topography_init()
227 
228  if (get_ocean_frac(blon, blat, ocean_frac) ) then
229  where (ocean_frac > 0.50_lkind)
230  ocean_mask = .true.
231  elsewhere
232  ocean_mask = .false.
233  end where
234  get_ocean_mask_1d_ = .true.
235  else
236  get_ocean_mask_1d_ = .false.
237  endif
238 !-----------------------------------------------------------------------
239 
240  end function get_ocean_mask_1d_
241 
242 !#######################################################################
243 
244  function get_ocean_mask_2d_(blon, blat, ocean_mask)
245 
246  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blon, blat
247  logical, intent(out), dimension(:,:) :: ocean_mask
248  logical :: GET_OCEAN_MASK_2D_
249  real(kind=fms_top_kind_), dimension(size(ocean_mask,1),size(ocean_mask,2)) :: ocean_frac
250  integer, parameter :: lkind = fms_top_kind_
251 !-----------------------------------------------------------------------
252  if (.not. module_is_initialized) call topography_init()
253 
254  if (get_ocean_frac(blon, blat, ocean_frac) ) then
255  where (ocean_frac > 0.50_lkind)
256  ocean_mask = .true.
257  elsewhere
258  ocean_mask = .false.
259  end where
260  get_ocean_mask_2d_ = .true.
261  else
262  get_ocean_mask_2d_ = .false.
263  endif
264 
265 !-----------------------------------------------------------------------
266 
267  end function get_ocean_mask_2d_
268 
269  !> @brief Returns the percent of water in a grid box.
270  !> @returns A logical value of true if the output field was successfully created. A value of false
271  !! may be returned if the Navy 1/6 degree percent water data set was not readable.
272  !!
273  !! @throws FATAL, shape(water_frac) is not equal to (/size(blon)-1,size(blat)-1/)
274  !! Check the input grid size and output field size.
275  function get_water_frac_1d_(blon, blat, water_frac)
276  real(kind=fms_top_kind_), intent(in), dimension(:) :: blon !< The longitude (in radians) at grid box boundaries.
277  real(kind=fms_top_kind_), intent(in), dimension(:) :: blat !< The latitude (in radians) at grid box boundaries.
278  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: water_frac !< The fractional amount (0 to 1) of water in a
279  !! grid box. The size of this field must be size(blon)-1 by size(blat)-1.
280  logical :: GET_WATER_FRAC_1D_
281  integer, parameter :: lkind = fms_top_kind_
282 
283 !-----------------------------------------------------------------------
284  if (.not. module_is_initialized) call topography_init()
285 
286  if ( any(shape(water_frac(:,:)) /= (/size(blon(:))-1,size(blat(:))-1/)) ) &
287  call error_mesg('get_water_frac_1d','shape(water_frac) is not&
288  & equal to (/size(blon)-1,size(blat)-1/))', fatal)
289 
290  get_water_frac_1d_ = open_water_file()
291  if(get_water_frac_1d_) call interp_water( blon, blat, water_frac )
292 
293 !-----------------------------------------------------------------------
294 
295  end function get_water_frac_1d_
296 
297 !#######################################################################
298 
299  function get_water_frac_2d_(blon, blat, water_frac)
300 
301  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blon !< The longitude (in radians) at grid box boundaries.
302  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blat !< The latitude (in radians) at grid box boundaries.
303  real(kind=fms_top_kind_), intent(out), dimension(:,:) :: water_frac !< The fractional amount (0 to 1) of water in a
304  !! grid box. The size of this field must be size(blon)-1 by size(blat)-1.
305  logical :: GET_WATER_FRAC_2D_
306  integer, parameter :: lkind = fms_top_kind_
307 
308 !-----------------------------------------------------------------------
309  if (.not. module_is_initialized) call topography_init()
310 
311  if ( any(shape(water_frac(:,:)) /= (/size(blon,1)-1,size(blon,2)-1/)) .or. &
312  any(shape(water_frac(:,:)) /= (/size(blat,1)-1,size(blat,2)-1/)) ) &
313  call error_mesg('get_water_frac_2d','shape(water_frac) is not&
314  & equal to (/size(blon,1)-1,size(blon,2)-1/))', fatal)
315 
316  get_water_frac_2d_ = open_water_file()
317  if(get_water_frac_2d_) call interp_water( blon, blat, water_frac )
318 
319 !-----------------------------------------------------------------------
320 
321  end function get_water_frac_2d_
322 
323 !#######################################################################
324 
325  !> @brief Returns a land-water mask in the given model grid boxes.
326  !> @return A logical value of TRUE is returned if the output field
327  !! was successfully created. A value of FALSE may be returned
328  !! if the Navy 1/6 degree percent water data set was not readable.
329  function get_water_mask_1d_(blon, blat, water_mask)
330 
331  real(kind=fms_top_kind_), intent(in), dimension(:) :: blon !< The longitude (in radians) at grid box boundaries.
332  real(kind=fms_top_kind_), intent(in), dimension(:) :: blat !< The latitude (in radians) at grid box boundaries.
333  logical, intent(out), dimension(:,:) :: water_mask !< A binary mask for water (true) or land (false).
334  !! The size of this field must be size(blon)-1 by size(blat)-1.
335  logical :: GET_WATER_MASK_1D_
336 
337  real(kind=fms_top_kind_), dimension(size(water_mask,1),size(water_mask,2)) :: water_frac
338  integer, parameter :: lkind = fms_top_kind_
339 !-----------------------------------------------------------------------
340  if (.not. module_is_initialized) call topography_init()
341 
342  if (get_water_frac(blon, blat, water_frac) ) then
343  where (water_frac > 0.50_lkind)
344  water_mask = .true.
345  elsewhere
346  water_mask = .false.
347  end where
348  get_water_mask_1d_ = .true.
349  else
350  get_water_mask_1d_ = .false.
351  endif
352 !-----------------------------------------------------------------------
353 
354  end function get_water_mask_1d_
355 
356 !#######################################################################
357 
358  function get_water_mask_2d_(blon, blat, water_mask)
359 
360  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blon !< The longitude (in radians) at grid box boundaries.
361  real(kind=fms_top_kind_), intent(in), dimension(:,:) :: blat !< The latitude (in radians) at grid box boundaries.
362  logical, intent(out), dimension(:,:) :: water_mask !< A binary mask for water (true) or land (false).
363  !! The size of this field must be size(blon)-1 by size(blat)-1.
364  logical :: GET_WATER_MASK_2D_
365  real(kind=fms_top_kind_), dimension(size(water_mask,1),size(water_mask,2)) :: water_frac
366  integer, parameter :: lkind = fms_top_kind_
367 !-----------------------------------------------------------------------
368  if (.not. module_is_initialized) call topography_init()
369 
370  if (get_water_frac(blon, blat, water_frac) ) then
371  where (water_frac > 0.50_lkind)
372  water_mask = .true.
373  elsewhere
374  water_mask = .false.
375  end where
376  get_water_mask_2d_ = .true.
377  else
378  get_water_mask_2d_ = .false.
379  endif
380 
381 !-----------------------------------------------------------------------
382 
383  end function get_water_mask_2d_
384 
385 !#######################################################################
386 
387 subroutine interp_topog_1d_( blon, blat, zout, flag)
388 real(kind=fms_top_kind_), intent(in) :: blon(:), blat(:)
389 real(kind=fms_top_kind_), intent(out) :: zout(:,:)
390 integer, intent(in), optional :: flag
391 
392 real(kind=fms_top_kind_) :: xdat(ipts+1), ydat(jpts+1)
393 real(kind=fms_top_kind_) :: zdat(ipts,jpts)
394 real(kind=fms_top_kind_) :: zout2(size(zout,1),size(zout,2))
395 integer, parameter :: lkind = fms_top_kind_
396 
397  call input_data(topog_index, xdat, ydat, zdat)
398 
399  call horiz_interp( zdat, xdat, ydat, blon, blat, zout )
400 
401 ! compute standard deviation if necessary.
402  if (present(flag)) then
403  if (flag == compute_stdev) then
404  zdat = zdat*zdat
405  call horiz_interp ( zdat, xdat, ydat, blon, blat, zout2 )
406  zout = zout2 - zout*zout
407  where (zout > 0.0_lkind)
408  zout = sqrt( zout )
409  elsewhere
410  zout = 0.0_lkind
411  endwhere
412  endif
413  endif
414 
415 end subroutine interp_topog_1d_
416 
417 !#######################################################################
418 
419 subroutine interp_topog_2d_( blon, blat, zout, flag )
420 real(kind=fms_top_kind_), intent(in) :: blon(:,:), blat(:,:)
421 real(kind=fms_top_kind_), intent(out) :: zout(:,:)
422 integer, intent(in), optional :: flag
423 
424 real(kind=fms_top_kind_) :: xdat(ipts+1), ydat(jpts+1)
425 real(kind=fms_top_kind_) :: zdat(ipts,jpts)
426 real(kind=fms_top_kind_) :: zout2(size(zout,1),size(zout,2))
427 integer, parameter :: lkind = fms_top_kind_
428 integer :: js, je
429 type (horiz_interp_type) :: Interp
430 
431  call input_data(topog_index, xdat, ydat, zdat)
432 
433  call find_indices( minval(blat), maxval(blat), ydat, js, je )
434 
435  call horiz_interp_new ( interp, xdat, ydat(js:je+1), blon, blat )
436  call horiz_interp ( interp, zdat(:,js:je), zout )
437 
438 ! compute standard deviation if necessary
439  if (present(flag)) then
440  if (flag == compute_stdev) then
441  zdat = zdat*zdat
442  call horiz_interp ( interp, zdat(:,js:je), zout2 )
443  zout = zout2 - zout*zout
444  where (zout > 0.0_lkind)
445  zout = sqrt( zout )
446  elsewhere
447  zout = 0.0_lkind
448  endwhere
449  endif
450  endif
451 
452  call horiz_interp_del( interp )
453 
454 end subroutine interp_topog_2d_
455 
456 !#######################################################################
457 
458 subroutine find_indices_( ybeg, yend, ydat, js, je )
459 real(kind=fms_top_kind_), intent(in) :: ybeg, yend, ydat(:)
460 integer, intent(out) :: js, je
461 integer :: j
462 integer, parameter :: lkind = fms_top_kind_
463 
464  js = 1
465  do j = 1, size(ydat(:))-1
466  if (ybeg >= ydat(j) .and. ybeg <= ydat(j+1)) then
467  js = j
468  exit
469  endif
470  enddo
471 
472  je = size(ydat(:))-1
473  do j = js, size(ydat(:))-1
474  if (yend >= ydat(j) .and. yend <= ydat(j+1)) then
475  je = j
476  exit
477  endif
478  enddo
479 
480 !print '(a,i2,2(a,f10.5),2(a,i4))', "PE=",mpp_pe()," phs=",ybeg," phn=",yend," js=",js," je=",je
481 
482 end subroutine find_indices_
483 
484 !#######################################################################
485 subroutine input_data_( indx, xdat, ydat, zdat )
486 integer, intent(in) :: indx
487 real(kind=fms_top_kind_), intent(out) :: xdat(ipts+1), ydat(jpts+1), zdat(ipts,jpts)
488 
489 if( file_is_opened(indx) ) then
490  call read_data(fileobj(indx), 'xdat', xdat)
491  call read_data(fileobj(indx), 'ydat', ydat)
492  call read_data(fileobj(indx), 'zdat', zdat)
493 endif
494 
495 end subroutine input_data_
496 
497 !#######################################################################
498 
499 subroutine interp_water_1d_( blon, blat, zout, do_ocean )
500 real(kind=fms_top_kind_), intent(in) :: blon(:), blat(:)
501 real(kind=fms_top_kind_), intent(out) :: zout(:,:)
502 logical, intent(in), optional :: do_ocean
503 real(kind=fms_top_kind_) :: xdat(ipts+1), ydat(jpts+1), zdat(ipts,jpts)
504  call input_data ( water_index, xdat, ydat, zdat )
505 
506 ! only use designated ocean points
507 if (present(do_ocean)) then
508  if (do_ocean) call determine_ocean_points (zdat)
509 endif
510 
511 ! interpolate onto output grid
512 call horiz_interp ( zdat, xdat, ydat, blon, blat, zout )
513 
514 end subroutine interp_water_1d_
515 
516 !#######################################################################
517 
518 subroutine interp_water_2d_( blon, blat, zout, do_ocean )
519 real(kind=fms_top_kind_), intent(in) :: blon(:,:), blat(:,:)
520 real(kind=fms_top_kind_), intent(out) :: zout(:,:)
521 logical, intent(in), optional :: do_ocean
522 real(kind=fms_top_kind_) :: xdat(ipts+1), ydat(jpts+1), zdat(ipts,jpts)
523 
524 call input_data ( water_index, xdat, ydat, zdat )
525 
526 ! only use designated ocean points
527 if (present(do_ocean)) then
528  if (do_ocean) call determine_ocean_points (zdat)
529 endif
530 
531 ! interpolate onto output grid
532 call horiz_interp ( zdat, xdat, ydat, blon, blat, zout )
533 
534 end subroutine interp_water_2d_
535 
536 !#######################################################################
537 
538 subroutine determine_ocean_points_(pctwater)
539 real(kind=fms_top_kind_), intent(inout) :: pctwater(:,:)
540 logical :: ocean(size(pctwater,1),size(pctwater,2))
541 integer :: i, j, m, n, im, ip, jm, jp, new
542 integer, parameter :: lkind = fms_top_kind_
543 real(kind=fms_top_kind_) :: ocean_pct_crit = 0.500_lkind
544 
545 
546 ! resolution of the grid
547 m = size(pctwater,1)
548 n = size(pctwater,2)
549 
550 ! the 1/6 degree navy percent water data set
551 ! designates ocean grid boxes as 100 percent water
552 ! all other grid boxes have <= 99 percent water
553 
554 ! set a mask for ocean grid boxes
555 ocean = (pctwater > 0.999_lkind)
556 new = count(ocean)
557 
558 ! set land grid boxes that have sufficient amount of water
559 ! to ocean grid boxes when they are adjacent to ocean points
560 ! iterate until there are no new ocean points
561 do
562  if (new == 0) exit
563  new = 0
564 
565  do j = 1, n
566  do i = 1, m
567  if (.not.ocean(i,j) .and. pctwater(i,j) > ocean_pct_crit) then
568  im = i-1; ip = i+1; jm = j-1; jp = j+1
569  if (im == 0) im = m
570  if (ip == m+1) ip = 1
571  if (jm == 0) jm = 1
572  if (jp == n+1) jp = n
573  ! check the 8 grid boxes that surround this grid box
574  if (ocean(im,j ) .or. ocean(ip,j ) .or. ocean(i ,jm) .or. ocean(i ,jp) .or. &
575  ocean(im,jm) .or. ocean(ip,jm) .or. ocean(ip,jp) .or. ocean(im,jp)) then
576  ocean(i,j) = .true.
577  new = new + 1
578  endif
579  endif
580  enddo
581  enddo
582  !print *, 'new=',new
583 
584 enddo
585 
586 ! final step is to elimate water percentage if land
587 where (.not.ocean) pctwater = 0.0_lkind
588 
589 end subroutine determine_ocean_points_
590 
591 !> @}
592 ! close documentation grouping