Skip to content

Commit

Permalink
Multiple output grids (NCAR#480)
Browse files Browse the repository at this point in the history 
Update fv3 cap and write grid component to enable outputting multiple domains.
This is done be creating an array of fcstGrids, and array of rout handles where each element of these arrays correspond to one atm domain.
In the write grid component updates were made to allow grid spec parameters for each output grid to be specified separately.

Co-authored-by: Gerhard Theurich <theurich@sourcespring.net>
  • Loading branch information
@DusanJovic-NOAA @theurich
DusanJovic-NOAA and theurich authored Feb 15, 2022
1 parent 91836a8 commit 9929dcd
Show file tree
Hide file tree
Showing 10 changed files with 1,033 additions and 933 deletions.
2 changes: 1 addition & 1 deletion atmos_cubed_sphere
Submodule atmos_cubed_sphere updated 3 files
+20 −2 driver/fvGFS/atmosphere.F90
+3 −0 driver/fvGFS/fv_nggps_diag.F90
+9 −26 model/fv_regional_bc.F90
17 changes: 14 additions & 3 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ module atmos_model_mod
use atmosphere_mod, only: atmosphere_scalar_field_halo
use atmosphere_mod, only: atmosphere_get_bottom_layer
use atmosphere_mod, only: set_atmosphere_pelist
use atmosphere_mod, only: Atm, mygrid
use atmosphere_mod, only: Atm, mygrid, get_nth_domain_info
use block_control_mod, only: block_control_type, define_blocks_packed
use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type

Expand Down Expand Up @@ -113,6 +113,7 @@ module atmos_model_mod
public atmos_model_exchange_phase_1, atmos_model_exchange_phase_2
public atmos_model_restart
public get_atmos_model_ungridded_dim
public atmos_model_get_nth_domain_info
public addLsmask2grid
public setup_exportdata
!-----------------------------------------------------------------------
Expand All @@ -125,6 +126,8 @@ module atmos_model_mod
integer :: layout(2) ! computer task laytout
logical :: regional ! true if domain is regional
logical :: nested ! true if there is a nest
integer :: ngrids !
integer :: mygrid !
integer :: mlon, mlat
integer :: iau_offset ! iau running window length
logical :: pe ! current pe.
Expand Down Expand Up @@ -526,7 +529,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
call atmosphere_resolution (nlon, nlat, global=.false.)
call atmosphere_resolution (mlon, mlat, global=.true.)
call alloc_atmos_data_type (nlon, nlat, Atmos)
call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%pelist)
call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%ngrids, Atmos%mygrid, Atmos%pelist)
call atmosphere_diag_axes (Atmos%axes)
call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc)
call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.)
Expand Down Expand Up @@ -2480,7 +2483,6 @@ subroutine assign_importdata(jdat, rc)

rc=0
!
if (mpp_pe() == mpp_root_pe()) print *,'end of assign_importdata'
end subroutine assign_importdata

!
Expand Down Expand Up @@ -2879,5 +2881,14 @@ subroutine addLsmask2grid(fcstGrid, rc)

end subroutine addLsmask2grid
!------------------------------------------------------------------------------
subroutine atmos_model_get_nth_domain_info(n, layout, nx, ny, pelist)
integer, intent(in) :: n
integer, intent(out) :: layout(2)
integer, intent(out) :: nx, ny
integer, pointer, intent(out) :: pelist(:)

call get_nth_domain_info(n, layout, nx, ny, pelist)

end subroutine atmos_model_get_nth_domain_info

end module atmos_model_mod
58 changes: 15 additions & 43 deletions fv3_cap.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,12 +37,11 @@ module fv3gfs_cap_mod
num_files, filename_base, &
wrttasks_per_group, n_group, &
lead_wrttask, last_wrttask, &
output_grid, output_file, &
nsout_io, iau_offset, lflname_fulltime
!
use module_fcst_grid_comp, only: fcstSS => SetServices, &
fcstGrid, numLevels, numSoilLayers, &
numTracers
numTracers, mygrid, grid_number_on_all_pets

use module_wrt_grid_comp, only: wrtSS => SetServices
!
Expand Down Expand Up @@ -187,7 +186,6 @@ subroutine InitializeAdvertise(gcomp, rc)
integer :: i, j, k, urc, ist
integer :: noutput_fh, nfh, nfh2
integer :: petcount
integer :: num_output_file
integer :: nfhmax_hf
real :: nfhmax
real :: output_startfh, outputfh, outputfh2(2)
Expand Down Expand Up @@ -218,7 +216,7 @@ subroutine InitializeAdvertise(gcomp, rc)
call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", &
call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="false", &
convention="NUOPC", purpose="Instance", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
profile_memory = (trim(value)/="false")
Expand Down Expand Up @@ -296,33 +294,6 @@ subroutine InitializeAdvertise(gcomp, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
enddo

allocate(output_file(num_files))
num_output_file = ESMF_ConfigGetLen(config=CF, label ='output_file:',rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
if (num_files == num_output_file) then
call ESMF_ConfigGetAttribute(CF,valueList=output_file,label='output_file:', &
count=num_files, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
do i = 1, num_files
if(output_file(i) /= "netcdf" .and. output_file(i) /= "netcdf_parallel") then
write(0,*)"fv3_cap.F90: only netcdf and netcdf_parallel are allowed for multiple values of output_file"
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
else if ( num_output_file == 1) then
call ESMF_ConfigGetAttribute(CF,valuelist=output_file,label='output_file:', count=1, rc=rc)
output_file(1:num_files) = output_file(1)
else
output_file(1:num_files) = 'netcdf'
endif
if(mype == 0) then
print *,'af nems config,num_files=',num_files
do i=1,num_files
print *,'num_file=',i,'filename_base= ',trim(filename_base(i)),&
' output_file= ',trim(output_file(i))
enddo
endif
!
! variables for output
call ESMF_ConfigGetAttribute(config=CF, value=nfhout, label ='nfhout:', default=-1,rc=rc)
call ESMF_ConfigGetAttribute(config=CF, value=nfhmax_hf,label ='nfhmax_hf:',default=-1,rc=rc)
Expand Down Expand Up @@ -428,7 +399,9 @@ subroutine InitializeAdvertise(gcomp, rc)

! pull out the item names and item types from fcstState
call ESMF_StateGet(fcstState, itemNameList=fcstItemNameList, &
itemTypeList=fcstItemTypeList, rc=rc)
itemTypeList=fcstItemTypeList, &
!itemorderflag=ESMF_ITEMORDER_ADDORDER, &
rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

! loop over all items in the fcstState and collect all FieldBundles
Expand Down Expand Up @@ -556,8 +529,8 @@ subroutine InitializeAdvertise(gcomp, rc)

if (i==1) then
! this is a Store() for the first wrtComp -> must do the Store()
call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,i), &
regridMethod=regridmethod, routehandle=routehandle(j,i), &
call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), &
regridMethod=regridmethod, routehandle=routehandle(j,1), &
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, &
srcTermProcessing=isrcTermProcessing, rc=rc)

Expand All @@ -584,10 +557,10 @@ subroutine InitializeAdvertise(gcomp, rc)
endif
write(msgString,"(A,I2.2,',',I2.2,A)") "... returned from wrtFB(",j,i, ") FieldBundleRegridStore()."
call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc)
enddo
enddo ! j=1, FBcount

! end write_groups
enddo
enddo ! i=1, write_groups
if(mype==0) print *,'in fv3cap init, time wrtcrt/regrdst',MPI_Wtime()-timerhs
deallocate(petList)
deallocate(originPetList)
Expand Down Expand Up @@ -793,7 +766,7 @@ subroutine InitializeRealize(gcomp, rc)
if (isPetLocal) then

! -- realize connected fields in exportState
call realizeConnectedCplFields(exportState, fcstGrid, &
call realizeConnectedCplFields(exportState, fcstGrid(mygrid), &
numLevels, numSoilLayers, numTracers, &
exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
Expand All @@ -803,7 +776,7 @@ subroutine InitializeRealize(gcomp, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

! -- realize connected fields in importState
call realizeConnectedCplFields(importState, fcstGrid, &
call realizeConnectedCplFields(importState, fcstGrid(mygrid), &
numLevels, numSoilLayers, numTracers, &
importFieldsInfo, 'FV3 Import', importFields, 9.99e20_ESMF_KIND_R8, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
Expand Down Expand Up @@ -896,7 +869,7 @@ subroutine ModelAdvance_phase2(gcomp, rc)
type(ESMF_Time) :: startTime
type(ESMF_TimeInterval) :: time_elapsed

integer :: na, i, urc
integer :: na, j, urc
integer :: nfseconds
logical :: fcstpe
character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase2)'
Expand Down Expand Up @@ -944,10 +917,10 @@ subroutine ModelAdvance_phase2(gcomp, rc)
call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

do i=1, FBCount
do j=1, FBCount

call ESMF_FieldBundleRegrid(fcstFB(i), wrtFB(i,n_group), &
routehandle=routehandle(i, n_group), &
call ESMF_FieldBundleRegrid(fcstFB(j), wrtFB(j,n_group), &
routehandle=routehandle(j, n_group), &
termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
!
Expand All @@ -956,7 +929,6 @@ subroutine ModelAdvance_phase2(gcomp, rc)
call ESMF_VMEpochExit(rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

! if(mype==0 .or. mype==lead_wrttask(1)) print *,'on wrt bf wrt run, na=',na
call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

Expand Down
9 changes: 7 additions & 2 deletions io/FV3GFS_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3081,7 +3081,7 @@ end subroutine store_data3D
!
#ifdef use_WRTCOMP

subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys)
subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc)
!
!-------------------------------------------------------------
!*** set esmf bundle for phys output fields
Expand All @@ -3098,9 +3098,11 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb
type(ESMF_Grid),intent(inout) :: fcst_grid
logical,intent(in) :: quilting
integer, intent(in) :: nbdlphys
integer,intent(out) :: rc

!
!*** local variables
integer i, j, k, n, rc, idx, ibdl, nbdl
integer i, j, k, n, idx, ibdl, nbdl
integer id, axis_length, direction, edges, axis_typ
integer num_attributes, num_field_dyn
integer currdate(6)
Expand Down Expand Up @@ -3227,6 +3229,7 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb
name="vertical_dim_labels", valueList=axis_name_vert, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
endif
deallocate(axis_name_vert)
endif

!*** add attributes
Expand Down Expand Up @@ -3341,6 +3344,8 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb
endif

enddo
deallocate(axis_name)
deallocate(all_axes)

end subroutine fv_phys_bundle_setup
!
Expand Down
30 changes: 16 additions & 14 deletions io/inline_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ module inline_post

contains

subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, &
subroutine inline_post_run(wrt_int_state,grid_id,mypei,mpicomp,lead_write, &
mynfhr,mynfmin,mynfsec)
!
! revision history:
Expand All @@ -30,21 +30,22 @@ subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, &
!-----------------------------------------------------------------------
!
type(wrt_internal_state),intent(in) :: wrt_int_state
integer,intent(in) :: grid_id
integer,intent(in) :: mypei
integer,intent(in) :: mpicomp
integer,intent(in) :: lead_write
integer,intent(in) :: mynfhr
integer,intent(in) :: mynfmin
integer,intent(in) :: mynfsec
!
if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid)
if(trim(output_grid) == 'gaussian_grid' &
.or. trim(output_grid) == 'global_latlon') then
if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid(grid_id))
if(trim(output_grid(grid_id)) == 'gaussian_grid' &
.or. trim(output_grid(grid_id)) == 'global_latlon') then
call post_run_gfs(wrt_int_state, mypei, mpicomp, lead_write, &
mynfhr, mynfmin,mynfsec)
else if( trim(output_grid) == 'regional_latlon' &
.or. trim(output_grid) == 'rotated_latlon' &
.or. trim(output_grid) == 'lambert_conformal') then
else if( trim(output_grid(grid_id)) == 'regional_latlon' &
.or. trim(output_grid(grid_id)) == 'rotated_latlon' &
.or. trim(output_grid(grid_id)) == 'lambert_conformal') then
if(mypei == 0) print *,'inline_post_run, call post_run_regional'
call post_run_regional(wrt_int_state, mypei, mpicomp, lead_write, &
mynfhr, mynfmin,mynfsec)
Expand All @@ -55,21 +56,22 @@ end subroutine inline_post_run
!
!-----------------------------------------------------------------------
!
subroutine inline_post_getattr(wrt_int_state)
subroutine inline_post_getattr(wrt_int_state,grid_id)
!
use esmf
!
implicit none
!
type(wrt_internal_state),intent(inout) :: wrt_int_state
integer, intent(in) :: grid_id
!
if(trim(output_grid) == 'gaussian_grid' &
.or. trim(output_grid) == 'global_latlon') then
if(trim(output_grid(grid_id)) == 'gaussian_grid' &
.or. trim(output_grid(grid_id)) == 'global_latlon') then
call post_getattr_gfs(wrt_int_state)
else if( trim(output_grid) == 'regional_latlon' &
.or. trim(output_grid) == 'rotated_latlon' &
.or. trim(output_grid) == 'lambert_conformal') then
call post_getattr_regional(wrt_int_state)
else if( trim(output_grid(grid_id)) == 'regional_latlon' &
.or. trim(output_grid(grid_id)) == 'rotated_latlon' &
.or. trim(output_grid(grid_id)) == 'lambert_conformal') then
call post_getattr_regional(wrt_int_state,grid_id)
endif
!
end subroutine inline_post_getattr
Expand Down
26 changes: 14 additions & 12 deletions io/module_fv3_io_def.F90
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module module_fv3_io_def
module module_fv3_io_def
!
!*** fv3 io related configration variables
!
Expand All @@ -9,24 +9,26 @@ module module_fv3_io_def
!
use esmf, only : esmf_maxstr
implicit none
!

integer :: num_pes_fcst
integer :: wrttasks_per_group, write_groups
integer :: n_group
integer :: num_files
character(len=esmf_maxstr) :: app_domain
character(len=esmf_maxstr) :: output_grid
integer :: imo,jmo
integer :: ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d
integer :: nbdlphys
integer :: nsout_io, iau_offset, ideflate, nbits
integer :: nsout_io, iau_offset
logical :: lflname_fulltime
real :: cen_lon, cen_lat, lon1, lat1, lon2, lat2, dlon, dlat
real :: stdlat1, stdlat2, dx, dy

character(len=esmf_maxstr),dimension(:),allocatable :: filename_base
character(len=esmf_maxstr),dimension(:),allocatable :: output_file
!

integer,dimension(:),allocatable :: lead_wrttask, last_wrttask
!
end module module_fv3_io_def

character(len=esmf_maxstr),dimension(:),allocatable :: output_grid
integer,dimension(:),allocatable :: imo,jmo
real,dimension(:),allocatable :: cen_lon, cen_lat
real,dimension(:),allocatable :: lon1, lat1, lon2, lat2, dlon, dlat
real,dimension(:),allocatable :: stdlat1, stdlat2, dx, dy
integer,dimension(:),allocatable :: ideflate, nbits
integer,dimension(:),allocatable :: ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d

end module module_fv3_io_def
Loading

0 comments on commit 9929dcd

Please sign in to comment.