Cleanup and rename search routine. More cleanup to output

module.

Fixes ufs-community#709.

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

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

sorc/sfc_climo_gen.fd/search2.f90 → 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