diff --git a/sorc/sfc_climo_gen.fd/interp2.F90 b/sorc/sfc_climo_gen.fd/interp2.F90 index 13002b80c..64207b5ec 100644 --- a/sorc/sfc_climo_gen.fd/interp2.F90 +++ b/sorc/sfc_climo_gen.fd/interp2.F90 @@ -18,6 +18,7 @@ subroutine interp2(localpet, input_file) longitude_field_mdl, mask_field_mdl, & land_frac_field_mdl use source_grid + use output_frac_cats, only : output_driver use utils use mpi @@ -214,7 +215,7 @@ subroutine interp2(localpet, input_file) endif enddo enddo - call search2 (data_mdl_one_tile, mask_mdl_one_tile, i_mdl, j_mdl, num_categories, tile, field_names(1)) + call search_frac_cats (data_mdl_one_tile, mask_mdl_one_tile, i_mdl, j_mdl, num_categories, tile, field_names(1)) print*,'after regrid ',data_mdl_one_tile(i_mdl/2,j_mdl/2,:) ! These points are all non-land. Set to 100% of the water category. @@ -248,7 +249,7 @@ subroutine interp2(localpet, input_file) ! under fractional grids, how do we define dominate category? dom_cat_mdl_one_tile = 0.0 dom_cat_mdl_one_tile = maxloc(data_mdl_one_tile,dim=3) - 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) + 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) endif enddo OUTPUT_LOOP diff --git a/sorc/sfc_climo_gen.fd/output_frac_cats.F90 b/sorc/sfc_climo_gen.fd/output_frac_cats.F90 index 8d14c6b19..31736806b 100644 --- a/sorc/sfc_climo_gen.fd/output_frac_cats.F90 +++ b/sorc/sfc_climo_gen.fd/output_frac_cats.F90 @@ -1,25 +1,39 @@ !> @file -!! @brief Output model data for a single tile and a single record. -!! @author George Gayno @date 2018 +!! @brief Write model categorical data for a single tile. +!! @author George Gayno NCEP/EMC @date 2022 -!> Output model data for a single tile and a single -!! record in netcdf format. +!> Output categorical data such as vegetation type. Include +!! percentage of each category within a model grid box and +!! the dominate category. !! -!! @param[in] data_one_tile Data to be output (single tile). -!! @param[in] lat_one_tile Latitude of tile. -!! @param[in] lon_one_tile Longitude of tile. -!! @param[in] field_idx Index of field within field name array. -!! @param[in] i_mdl i dimensions of tile. -!! @param[in] j_mdl j dimensions of tile. +!! @author George Gayno NCEP/EMC @date 2022 + module output_frac_cats + + implicit none + + private + + public :: output_driver + + contains + +!> Driver routine to output model categorical data. +!! +!! @param[in] data_one_tile The percentage of each category within a model grid cell. +!! @param[in] dom_cat_one_tile The dominate category within a model grid cell. +!! @param[in] lat_one_tile Latitude of each model grid cell. +!! @param[in] lon_one_tile Longitude of each model grid cell. +!! @param[in] i_mdl i dimension of model grid. +!! @param[in] j_mdl j dimension of model grid. +!! @param[in] num_categories Number of categories. !! @param[in] tile Tile number. -!! @author George Gayno @date 2018 - subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, i_mdl, j_mdl, & - num_categories, tile) +!! @author George Gayno @date 2022 + subroutine output_driver(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, & + i_mdl, j_mdl, num_categories, tile) use mpi use esmf - use source_grid, only : field_names, & - num_time_recs + use source_grid, only : field_names use model_grid, only : grid_tiles use program_setup, only : halo @@ -29,7 +43,7 @@ subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, real(esmf_kind_r4), intent(in) :: data_one_tile(i_mdl,j_mdl,num_categories) real(esmf_kind_r4), intent(in) :: dom_cat_one_tile(i_mdl,j_mdl) - real(esmf_kind_r4) :: lat_one_tile(i_mdl,j_mdl) + real(esmf_kind_r4), intent(in) :: lat_one_tile(i_mdl,j_mdl) real(esmf_kind_r4), intent(in) :: lon_one_tile(i_mdl,j_mdl) character(len=200) :: out_file @@ -67,38 +81,48 @@ subroutine output2(data_one_tile, dom_cat_one_tile, lat_one_tile, lon_one_tile, j_end = j_mdl - halo i_out = i_end - i_start + 1 j_out = j_end - j_start + 1 - call writeit(out_file, i_out, j_out, num_categories, num_time_recs, & + call writeit(out_file, i_out, j_out, num_categories, & lat_one_tile(i_start:i_end,j_start:j_end), & lon_one_tile(i_start:i_end,j_start:j_end), & data_one_tile(i_start:i_end,j_start:j_end,:), & dom_cat_one_tile(i_start:i_end,j_start:j_end) ) print*,"- WILL WRITE FULL DOMAIN INCLUDING HALO." - call writeit(out_file_with_halo, i_mdl, j_mdl, num_categories, num_time_recs, & + call writeit(out_file_with_halo, i_mdl, j_mdl, num_categories, & lat_one_tile, lon_one_tile, data_one_tile, dom_cat_one_tile) else print*,"- WILL WRITE DATA." - call writeit(out_file, i_mdl, j_mdl, num_categories, num_time_recs, & + call writeit(out_file, i_mdl, j_mdl, num_categories, & lat_one_tile, lon_one_tile, data_one_tile, dom_cat_one_tile) endif return - end subroutine output2 + end subroutine output_driver - subroutine writeit(out_file, iout, jout, num_categories, num_time_recs, & +!> Write data to a netcdf file. +!! +!! @param[in] out_file Output file name. +!! @param[in] iout i-dimension of data. +!! @param[in] jout j-dimension of data. +!! @param[in] num_categories Number of categories. +!! @param[in] latitude Latitude of data. +!! @param[in] latitude Longitude of data. +!! @param[in] data_pct Percentage of each category in each model grid cell. +!! @param[in] dominate_cat Dominate category in each model grid cell. + subroutine writeit(out_file, iout, jout, num_categories, & latitude, longitude, data_pct, dominate_cat) use esmf use netcdf use utils - use source_grid, only : day_of_rec, source, field_names + use source_grid, only : day_of_rec, source, field_names, num_time_recs use model_grid, only : missing implicit none character(len=*), intent(in) :: out_file - integer, intent(in) :: iout, jout, num_categories, num_time_recs + integer, intent(in) :: iout, jout, num_categories real(esmf_kind_r4), intent(in) :: latitude(iout,jout) real(esmf_kind_r4), intent(in) :: longitude(iout,jout) @@ -194,3 +218,5 @@ subroutine writeit(out_file, iout, jout, num_categories, num_time_recs, & error = nf90_close(ncid) end subroutine writeit + + end module output_frac_cats diff --git a/sorc/sfc_climo_gen.fd/search2.f90 b/sorc/sfc_climo_gen.fd/search_frac_cats.f90 similarity index 62% rename from sorc/sfc_climo_gen.fd/search2.f90 rename to sorc/sfc_climo_gen.fd/search_frac_cats.f90 index 5246bfb3f..09ead8929 100644 --- a/sorc/sfc_climo_gen.fd/search2.f90 +++ b/sorc/sfc_climo_gen.fd/search_frac_cats.f90 @@ -1,48 +1,45 @@ !> @file -!! @brief Replace undefined values on the model grid with a valid -!! value at a nearby neighbor. This routine works for fractional -!! categorical fields. +!! @brief Replace undefined values on the model grid. !! @author George Gayno @date 2022 -!> Replace undefined values on the model grid with a valid -!! value at a nearby neighbor. Undefined values are typically +!> Replace undefined values on the model grid with valid +!! values at a nearby neighbor. Undefined values are typically !! associated with isolated islands where there is no source data. !! Routine searches a neighborhood with a radius of 100 grid points. -!! If no valid value is found, a default value is used. This +!! If no valid values are found, a default value is used. This !! routine works for one tile of a cubed sphere grid. It does -!! not consider valid values at adjacent faces. That is a future -!! upgrade. +!! not consider valid values at adjacent faces. This routine +!! works for fractional categorical fields, such as soil +!! type. !! -!! @note This routine works for fractional categorical fields. -!! -!! @param[inout] field - input: field before missing values are replaced -!! - output: field after missing values are replaced -!! @param[in] mask field bitmap. Field defined where mask=1 -!! @param[in] idim i dimension of tile -!! @param[in] jdim j dimension of tile -!! @param[in] num_categories number of veg/soil categories -!! @param[in] tile tile number -!! @param[in] field_name field name +!! @param[inout] field - input: Field before missing values are replaced. +!! - output: Field after missing values are replaced. +!! @param[in] mask Field bitmap. Field defined where mask=1. +!! @param[in] idim i dimension of tile. +!! @param[in] jdim j dimension of tile. +!! @param[in] num_categories Number of veg/soil categories. +!! @param[in] tile Tile number. +!! @param[in] field_name Field name. !! @author George Gayno @date 2022 - subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name) + subroutine search_frac_cats (field, mask, idim, jdim, num_categories, tile, field_name) use mpi use esmf implicit none - character(len=*) :: field_name - integer, intent(in) :: idim, jdim, tile, num_categories integer(esmf_kind_i4), intent(in) :: mask(idim,jdim) real(esmf_kind_r4), intent(inout) :: field(idim,jdim,num_categories) + character(len=*) :: field_name + integer :: i, j, krad, ii, jj integer :: istart, iend integer :: jstart, jend integer :: ierr - integer :: default_category + integer :: default_category real(esmf_kind_r4), allocatable :: field_save(:,:,:) @@ -92,10 +89,9 @@ subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name) if (jj < 1 .or. jj > jdim) cycle JJ_LOOP if (ii < 1 .or. ii > idim) cycle II_LOOP - print*,'in search ',ii,jj,mask(ii,jj),maxval(field_save(ii,jj,:)) - if (mask(ii,jj) == 1 .and. maxval(field_save(ii,jj,:)) > 0.0) then + if (mask(ii,jj) == 1 .and. maxval(field_save(ii,jj,:)) > 0.0) then field(i,j,:) = field_save(ii,jj,:) - write(6,100) tile,i,j,ii,jj,field(i,j,1) + write(6,100) tile,i,j,ii,jj cycle I_LOOP endif @@ -115,13 +111,9 @@ subroutine search2 (field, mask, idim, jdim, num_categories, tile, field_name) enddo I_LOOP enddo J_LOOP - print*,'after search 59/166 ',field(59,166,:) - print*,'after search 60/167 ',field(60,167,:) - print*,'after search 55/168 ',field(55,168,:) - print*,'after search 56/169 ',field(55,168,:) deallocate(field_save) - 100 format(1x,"- MISSING2 POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5,". NEW VALUE IS: ",f8.3) - 101 format(1x,"- MISSING2 POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",f8.3) + 100 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5) + 101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",i3) - end subroutine search2 + end subroutine search_frac_cats