Skip to content

Commit

Permalink
Use inline post with cubed sphere history output (#680)
Browse files Browse the repository at this point in the history 
* Add option to output top parent history file on cubed sphere grid

* Rename module_configure parameter, history_file_on_native_grid
  • Loading branch information
@DusanJovic-NOAA
DusanJovic-NOAA authored Jul 31, 2023
1 parent 1158696 commit f595b97
Show file tree
Hide file tree
Showing 5 changed files with 228 additions and 213 deletions.
9 changes: 5 additions & 4 deletions fv3_cap.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,7 +209,7 @@ subroutine InitializeAdvertise(gcomp, rc)
integer :: wrttasks_per_group_from_parent, wrtLocalPet, num_threads
character(len=64) :: rh_filename
logical :: use_saved_routehandles, rh_file_exist
logical :: fieldbundle_is_restart = .false.
logical :: fieldbundle_uses_redist = .false.

integer :: sloc
type(ESMF_StaggerLoc) :: staggerloc
Expand Down Expand Up @@ -698,11 +698,12 @@ subroutine InitializeAdvertise(gcomp, rc)
if(mype == 0) print *,'af get wrtfb=',"output_"//trim(fcstItemNameList(j)),' rc=',rc
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

fieldbundle_is_restart = .false.
fieldbundle_uses_redist = .false.
! if (fcstItemNameList(j)(1:8) == "restart_" .or. fcstItemNameList(j)(1:18) == "cubed_sphere_grid_") then
if (fcstItemNameList(j)(1:8) == "restart_") then
! restart output forecast bundles, no need to set regridmethod
! Redist will be used instead of Regrid
fieldbundle_is_restart = .true.
fieldbundle_uses_redist = .true.
else
! history output forecast bundles
! determine regridmethod
Expand Down Expand Up @@ -739,7 +740,7 @@ subroutine InitializeAdvertise(gcomp, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
else
! this is a Store() for the first wrtComp -> must do the Store()
if (fieldbundle_is_restart) then
if (fieldbundle_uses_redist) then
call ESMF_TraceRegionEnter("ESMF_FieldBundleRedistStore()", rc=rc)
call ESMF_FieldBundleRedistStore(fcstFB(j), wrtFB(j,1), &
routehandle=routehandle(j,1), &
Expand Down
58 changes: 27 additions & 31 deletions io/module_write_netcdf.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ module module_write_netcdf
use netcdf
use module_fv3_io_def,only : ideflate, nbits, &
ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, &
output_grid,dx,dy,lon1,lat1,lon2,lat2, &
dx,dy,lon1,lat1,lon2,lat2, &
time_unlimited
use mpi

Expand Down Expand Up @@ -95,6 +95,7 @@ subroutine write_netcdf(wrtfb, filename, &
integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap
logical :: do_io
integer :: par_access
character(len=ESMF_MAXSTR) :: output_grid_name
!
is_cubed_sphere = .false.
tileCount = 0
Expand All @@ -106,13 +107,15 @@ subroutine write_netcdf(wrtfb, filename, &
do_io = par .or. (mype==0)

call ESMF_FieldBundleGet(wrtfb, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc)
call ESMF_AttributeGet(wrtfb, convention="NetCDF", purpose="FV3", &
name='grid', value=output_grid_name, rc=rc); ESMF_ERR_RETURN(rc)

allocate(compress_err(fieldCount)); compress_err=-999.
allocate(fldlev(fieldCount)) ; fldlev = 0
allocate(fcstField(fieldCount))
allocate(varids(fieldCount))

call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtGrid, &
call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtgrid, &
! itemorderflag=ESMF_ITEMORDER_ADDORDER, &
rc=rc); ESMF_ERR_RETURN(rc)

Expand Down Expand Up @@ -162,6 +165,10 @@ subroutine write_netcdf(wrtfb, filename, &
start_i = 1
start_j = 1
end if
if (is_cubed_sphere) then
start_i = mod(start_i, im)
start_j = mod(start_j, jm)
end if
end if

if (fieldDimCount > gridDimCount) then
Expand Down Expand Up @@ -240,21 +247,18 @@ subroutine write_netcdf(wrtfb, filename, &
ncerr = nf90_put_att(ncid, timeiso_varid, "_Encoding", "UTF-8"); NC_ERR_STOP(ncerr)

! coordinate variable attributes based on output_grid type
if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. &
trim(output_grid(grid_id)) == 'global_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon_moving') then
if (trim(output_grid_name) == 'gaussian' .or. &
trim(output_grid_name) == 'latlon') then
ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. &
trim(output_grid(grid_id)) == 'rotated_latlon_moving') then
else if (trim(output_grid_name) == 'rotated_latlon') then
ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'lambert_conformal') then
else if (trim(output_grid_name) == 'lambert_conformal') then
ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr)
ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr)
Expand Down Expand Up @@ -466,10 +470,10 @@ subroutine write_netcdf(wrtfb, filename, &

! write lon (lon_varid)
if (par) then
call ESMF_GridGetCoord(wrtGrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc)
call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc)
ncerr = nf90_put_var(ncid, lon_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr)
else
call ESMF_GridGetCoord(wrtGrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc)
call ESMF_GridGetCoord(wrtgrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc)
if (is_cubed_sphere) then
do t=1,tileCount
call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc)
Expand All @@ -491,39 +495,35 @@ subroutine write_netcdf(wrtfb, filename, &
! write grid_xt (im_varid)
if (do_io) then
allocate (x(im))
if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. &
trim(output_grid(grid_id)) == 'global_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon_moving') then
if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then
ncerr = nf90_put_var(ncid, im_varid, values=array_r8(:,jstart), start=[istart], count=[iend-istart+1]); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. &
trim(output_grid(grid_id)) == 'rotated_latlon_moving') then
else if (trim(output_grid_name) == 'rotated_latlon') then
do i=1,im
x(i) = lon1(grid_id) + (lon2(grid_id)-lon1(grid_id))/(im-1) * (i-1)
end do
ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'lambert_conformal') then
else if (trim(output_grid_name) == 'lambert_conformal') then
do i=1,im
x(i) = dx(grid_id) * (i-1)
end do
ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then
else if (trim(output_grid_name) == 'cubed_sphere') then
do i=1,im
x(i) = i
end do
ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr)
else
if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id))
if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
end if
end if

! write lat (lat_varid)
if (par) then
call ESMF_GridGetCoord(wrtGrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc)
call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc)
ncerr = nf90_put_var(ncid, lat_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr)
else
call ESMF_GridGetCoord(wrtGrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc)
call ESMF_GridGetCoord(wrtgrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc)
if (is_cubed_sphere) then
do t=1,tileCount
call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc)
Expand All @@ -542,29 +542,25 @@ subroutine write_netcdf(wrtfb, filename, &
! write grid_yt (jm_varid)
if (do_io) then
allocate (y(jm))
if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. &
trim(output_grid(grid_id)) == 'global_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon' .or. &
trim(output_grid(grid_id)) == 'regional_latlon_moving') then
if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then
ncerr = nf90_put_var(ncid, jm_varid, values=array_r8(istart,:), start=[jstart], count=[jend-jstart+1]); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. &
trim(output_grid(grid_id)) == 'rotated_latlon_moving') then
else if (trim(output_grid_name) == 'rotated_latlon') then
do j=1,jm
y(j) = lat1(grid_id) + (lat2(grid_id)-lat1(grid_id))/(jm-1) * (j-1)
end do
ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'lambert_conformal') then
else if (trim(output_grid_name) == 'lambert_conformal') then
do j=1,jm
y(j) = dy(grid_id) * (j-1)
end do
ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr)
else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then
else if (trim(output_grid_name) == 'cubed_sphere') then
do j=1,jm
y(j) = j
end do
ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr)
else
if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id))
if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
end if
end if
Expand Down
Loading

0 comments on commit f595b97

Please sign in to comment.