Skip to content

Commit 28e70e7

Browse files
GeorgeGayno-NOAAGeorgeGayno-NOAA
committed
Cleanup and rename search routine. More cleanup to output
module. Fixes ufs-community#709.
1 parent d5a349f commit 28e70e7

File tree

3 files changed

+76
-57
lines changed

3 files changed

+76
-57
lines changed

‎sorc/sfc_climo_gen.fd/interp2.F90

+3-2
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ subroutine interp2(localpet, input_file)
1818
longitude_field_mdl, mask_field_mdl, &
1919
land_frac_field_mdl
2020
use source_grid
21+
use output_frac_cats, only : output_driver
2122
use utils
2223
use mpi
2324

@@ -214,7 +215,7 @@ subroutine interp2(localpet, input_file)
214215
endif
215216
enddo
216217
enddo
217-
call search2 (data_mdl_one_tile, mask_mdl_one_tile, i_mdl, j_mdl, num_categories, tile, field_names(1))
218+
call search_frac_cats (data_mdl_one_tile, mask_mdl_one_tile, i_mdl, j_mdl, num_categories, tile, field_names(1))
218219
print*,'after regrid ',data_mdl_one_tile(i_mdl/2,j_mdl/2,:)
219220

220221
! These points are all non-land. Set to 100% of the water category.
@@ -248,7 +249,7 @@ subroutine interp2(localpet, input_file)
248249
! under fractional grids, how do we define dominate category?
249250
dom_cat_mdl_one_tile = 0.0
250251
dom_cat_mdl_one_tile = maxloc(data_mdl_one_tile,dim=3)
251-
call output2 (data_mdl_one_tile, dom_cat_mdl_one_tile, lat_mdl_one_tile, lon_mdl_one_tile, i_mdl, j_mdl, num_categories, tile)
252+
call output_driver (data_mdl_one_tile, dom_cat_mdl_one_tile, lat_mdl_one_tile, lon_mdl_one_tile, i_mdl, j_mdl, num_categories, tile)
252253
endif
253254

254255
enddo OUTPUT_LOOP

‎sorc/sfc_climo_gen.fd/output_frac_cats.F90

+49-23
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,39 @@
11
!> @file
2-
!! @brief Output model data for a single tile and a single record.
3-
!! @author George Gayno @date 2018
2+
!! @brief Write model categorical data for a single tile.
3+
!! @author George Gayno NCEP/EMC @date 2022
44

5-
!> Output model data for a single tile and a single
6-
!! record in netcdf format.
5+
!> Output categorical data such as vegetation type. Include
6+
!! percentage of each category within a model grid box and
7+
!! the dominate category.
78
!!
8-
!! @param[in] data_one_tile Data to be output (single tile).
9-
!! @param[in] lat_one_tile Latitude of tile.
10-
!! @param[in] lon_one_tile Longitude of tile.
11-
!! @param[in] field_idx Index of field within field name array.
12-
!! @param[in] i_mdl i dimensions of tile.
13-
!! @param[in] j_mdl j dimensions of tile.
9+
!! @author George Gayno NCEP/EMC @date 2022
10+
module output_frac_cats
11+
12+
implicit none
13+
14+
private
15+
16+
public :: output_driver
17+
18+
contains
19+
20+
!> Driver routine to output model categorical data.
21+
!!
22+
!! @param[in] data_one_tile The percentage of each category within a model grid cell.
23+
!! @param[in] dom_cat_one_tile The dominate category within a model grid cell.
24+
!! @param[in] lat_one_tile Latitude of each model grid cell.
25+
!! @param[in] lon_one_tile Longitude of each model grid cell.
26+
!! @param[in] i_mdl i dimension of model grid.
27+
!! @param[in] j_mdl j dimension of model grid.
28+
!! @param[in] num_categories Number of categories.
1429
!! @param[in] tile Tile number.
15-
!! @author George Gayno @date 2018
16-
subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, i_mdl, j_mdl, &
17-
num_categories, tile)
30+
!! @author George Gayno @date 2022
31+
subroutine output_driver(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, &
32+
i_mdl, j_mdl, num_categories, tile)
1833

1934
use mpi
2035
use esmf
21-
use source_grid, only : field_names, &
22-
num_time_recs
36+
use source_grid, only : field_names
2337
use model_grid, only : grid_tiles
2438
use program_setup, only : halo
2539

@@ -29,7 +43,7 @@ subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile,
2943

3044
real(esmf_kind_r4), intent(in) :: data_one_tile(i_mdl,j_mdl,num_categories)
3145
real(esmf_kind_r4), intent(in) :: dom_cat_one_tile(i_mdl,j_mdl)
32-
real(esmf_kind_r4) :: lat_one_tile(i_mdl,j_mdl)
46+
real(esmf_kind_r4), intent(in) :: lat_one_tile(i_mdl,j_mdl)
3347
real(esmf_kind_r4), intent(in) :: lon_one_tile(i_mdl,j_mdl)
3448

3549
character(len=200) :: out_file
@@ -67,38 +81,48 @@ subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile,
6781
j_end = j_mdl - halo
6882
i_out = i_end - i_start + 1
6983
j_out = j_end - j_start + 1
70-
call writeit(out_file, i_out, j_out, num_categories, num_time_recs, &
84+
call writeit(out_file, i_out, j_out, num_categories, &
7185
lat_one_tile(i_start:i_end,j_start:j_end), &
7286
lon_one_tile(i_start:i_end,j_start:j_end), &
7387
data_one_tile(i_start:i_end,j_start:j_end,:), &
7488
dom_cat_one_tile(i_start:i_end,j_start:j_end) )
7589
print*,"- WILL WRITE FULL DOMAIN INCLUDING HALO."
76-
call writeit(out_file_with_halo, i_mdl, j_mdl, num_categories, num_time_recs, &
90+
call writeit(out_file_with_halo, i_mdl, j_mdl, num_categories, &
7791
lat_one_tile, lon_one_tile, data_one_tile, dom_cat_one_tile)
7892
else
7993
print*,"- WILL WRITE DATA."
80-
call writeit(out_file, i_mdl, j_mdl, num_categories, num_time_recs, &
94+
call writeit(out_file, i_mdl, j_mdl, num_categories, &
8195
lat_one_tile, lon_one_tile, data_one_tile, dom_cat_one_tile)
8296
endif
8397

8498
return
8599

86-
end subroutine output2
100+
end subroutine output_driver
87101

88-
subroutine writeit(out_file, iout, jout, num_categories, num_time_recs, &
102+
!> Write data to a netcdf file.
103+
!!
104+
!! @param[in] out_file Output file name.
105+
!! @param[in] iout i-dimension of data.
106+
!! @param[in] jout j-dimension of data.
107+
!! @param[in] num_categories Number of categories.
108+
!! @param[in] latitude Latitude of data.
109+
!! @param[in] latitude Longitude of data.
110+
!! @param[in] data_pct Percentage of each category in each model grid cell.
111+
!! @param[in] dominate_cat Dominate category in each model grid cell.
112+
subroutine writeit(out_file, iout, jout, num_categories, &
89113
latitude, longitude, data_pct, dominate_cat)
90114

91115
use esmf
92116
use netcdf
93117
use utils
94-
use source_grid, only : day_of_rec, source, field_names
118+
use source_grid, only : day_of_rec, source, field_names, num_time_recs
95119
use model_grid, only : missing
96120

97121
implicit none
98122

99123
character(len=*), intent(in) :: out_file
100124

101-
integer, intent(in) :: iout, jout, num_categories, num_time_recs
125+
integer, intent(in) :: iout, jout, num_categories
102126

103127
real(esmf_kind_r4), intent(in) :: latitude(iout,jout)
104128
real(esmf_kind_r4), intent(in) :: longitude(iout,jout)
@@ -194,3 +218,5 @@ subroutine writeit(out_file, iout, jout, num_categories, num_time_recs, &
194218
error = nf90_close(ncid)
195219

196220
end subroutine writeit
221+
222+
end module output_frac_cats

‎sorc/sfc_climo_gen.fd/search2.f90 ‎sorc/sfc_climo_gen.fd/search_frac_cats.f90

+24-32
Original file line numberDiff line numberDiff line change
@@ -1,48 +1,45 @@
11
!> @file
2-
!! @brief Replace undefined values on the model grid with a valid
3-
!! value at a nearby neighbor. This routine works for fractional
4-
!! categorical fields.
2+
!! @brief Replace undefined values on the model grid.
53
!! @author George Gayno @date 2022
64

7-
!> Replace undefined values on the model grid with a valid
8-
!! value at a nearby neighbor. Undefined values are typically
5+
!> Replace undefined values on the model grid with valid
6+
!! values at a nearby neighbor. Undefined values are typically
97
!! associated with isolated islands where there is no source data.
108
!! Routine searches a neighborhood with a radius of 100 grid points.
11-
!! If no valid value is found, a default value is used. This
9+
!! If no valid values are found, a default value is used. This
1210
!! routine works for one tile of a cubed sphere grid. It does
13-
!! not consider valid values at adjacent faces. That is a future
14-
!! upgrade.
11+
!! not consider valid values at adjacent faces. This routine
12+
!! works for fractional categorical fields, such as soil
13+
!! type.
1514
!!
16-
!! @note This routine works for fractional categorical fields.
17-
!!
18-
!! @param[inout] field - input: field before missing values are replaced
19-
!! - output: field after missing values are replaced
20-
!! @param[in] mask field bitmap. Field defined where mask=1
21-
!! @param[in] idim i dimension of tile
22-
!! @param[in] jdim j dimension of tile
23-
!! @param[in] num_categories number of veg/soil categories
24-
!! @param[in] tile tile number
25-
!! @param[in] field_name field name
15+
!! @param[inout] field - input: Field before missing values are replaced.
16+
!! - output: Field after missing values are replaced.
17+
!! @param[in] mask Field bitmap. Field defined where mask=1.
18+
!! @param[in] idim i dimension of tile.
19+
!! @param[in] jdim j dimension of tile.
20+
!! @param[in] num_categories Number of veg/soil categories.
21+
!! @param[in] tile Tile number.
22+
!! @param[in] field_name Field name.
2623
!! @author George Gayno @date 2022
27-
subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name)
24+
subroutine search_frac_cats (field, mask, idim, jdim, num_categories, tile, field_name)
2825

2926
use mpi
3027
use esmf
3128

3229
implicit none
3330

34-
character(len=*) :: field_name
35-
3631
integer, intent(in) :: idim, jdim, tile, num_categories
3732
integer(esmf_kind_i4), intent(in) :: mask(idim,jdim)
3833

3934
real(esmf_kind_r4), intent(inout) :: field(idim,jdim,num_categories)
4035

36+
character(len=*) :: field_name
37+
4138
integer :: i, j, krad, ii, jj
4239
integer :: istart, iend
4340
integer :: jstart, jend
4441
integer :: ierr
45-
integer :: default_category
42+
integer :: default_category
4643

4744
real(esmf_kind_r4), allocatable :: field_save(:,:,:)
4845

@@ -92,10 +89,9 @@ subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name)
9289
if (jj < 1 .or. jj > jdim) cycle JJ_LOOP
9390
if (ii < 1 .or. ii > idim) cycle II_LOOP
9491

95-
print*,'in search ',ii,jj,mask(ii,jj),maxval(field_save(ii,jj,:))
96-
if (mask(ii,jj) == 1 .and. maxval(field_save(ii,jj,:)) > 0.0) then
92+
if (mask(ii,jj) == 1 .and. maxval(field_save(ii,jj,:)) > 0.0) then
9793
field(i,j,:) = field_save(ii,jj,:)
98-
write(6,100) tile,i,j,ii,jj,field(i,j,1)
94+
write(6,100) tile,i,j,ii,jj
9995
cycle I_LOOP
10096
endif
10197

@@ -115,13 +111,9 @@ subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name)
115111
enddo I_LOOP
116112
enddo J_LOOP
117113

118-
print*,'after search 59/166 ',field(59,166,:)
119-
print*,'after search 60/167 ',field(60,167,:)
120-
print*,'after search 55/168 ',field(55,168,:)
121-
print*,'after search 56/169 ',field(55,168,:)
122114
deallocate(field_save)
123115

124-
100 format(1x,"- MISSING2 POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5,". NEW VALUE IS: ",f8.3)
125-
101 format(1x,"- MISSING2 POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",f8.3)
116+
100 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5)
117+
101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",i3)
126118

127-
end subroutine search2
119+
end subroutine search_frac_cats

0 commit comments

Comments
 (0)