Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update to the latest noaa-gfdl dev/emc branch #69

Merged
merged 13 commits into from
Mar 2, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 20 additions & 2 deletions driver/fvGFS/atmosphere.F90
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,8 @@ module atmosphere_mod
atmosphere_get_bottom_layer, &
atmosphere_nggps_diag, &
get_bottom_mass, get_bottom_wind, &
get_stock_pe, set_atmosphere_pelist
get_stock_pe, set_atmosphere_pelist, &
get_nth_domain_info

!--- physics/radiation data exchange routines
public :: atmos_phys_driver_statein
Expand Down Expand Up @@ -918,15 +919,30 @@ subroutine set_atmosphere_pelist ()
end subroutine set_atmosphere_pelist


subroutine 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(:)

layout(1:2) = Atm(n)%layout(1:2)
nx = Atm(n)%npx -1
ny = Atm(n)%npy -1
pelist => Atm(n)%pelist

end subroutine get_nth_domain_info

!>@brief The subroutine 'atmosphere_domain' is an API to return
!! the "domain2d" variable associated with the coupling grid and the
!! decomposition for the current cubed-sphere tile.
!>@detail Coupling is done using the mass/temperature grid with no halos.
subroutine atmosphere_domain ( fv_domain, layout, regional, nested, pelist )
subroutine atmosphere_domain ( fv_domain, layout, regional, nested, ngrids_atmos, mygrid_atmos, pelist )
type(domain2d), intent(out) :: fv_domain
integer, intent(out) :: layout(2)
logical, intent(out) :: regional
logical, intent(out) :: nested
integer, intent(out) :: ngrids_atmos
integer, intent(out) :: mygrid_atmos
integer, pointer, intent(out) :: pelist(:)
! returns the domain2d variable associated with the coupling grid
! note: coupling is done using the mass/temperature grid with no halos
Expand All @@ -935,6 +951,8 @@ subroutine atmosphere_domain ( fv_domain, layout, regional, nested, pelist )
layout(1:2) = Atm(mygrid)%layout(1:2)
regional = Atm(mygrid)%flagstruct%regional
nested = ngrids > 1
ngrids_atmos = ngrids
mygrid_atmos = mygrid
call set_atmosphere_pelist()
pelist => Atm(mygrid)%pelist

Expand Down
3 changes: 3 additions & 0 deletions driver/fvGFS/fv_nggps_diag.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1007,6 +1007,7 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting, rc)
line=__LINE__, &
file=__FILE__)) &
return ! bail out
deallocate(axis_name_vert)
endif

do id = 1,num_axes
Expand Down Expand Up @@ -1349,6 +1350,8 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting, rc)
! name="output_file", value=fld_outfilename, rc=rc)
! print *,'in dyn bundle setup, i=',i,' fieldname=',trim(fieldnamelist(i)),' out filename=',trim(fld_outfilename)
! enddo
deallocate(axis_name)
deallocate(all_axes)

end subroutine fv_dyn_bundle_setup

Expand Down
26 changes: 13 additions & 13 deletions model/dyn_core.F90
Original file line number Diff line number Diff line change
Expand Up @@ -561,13 +561,13 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp,
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
#ifndef SW_DYNAMICS
call regional_boundary_update(ptc, 'pt', &
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
#endif
endif
if ( hydrostatic ) then
Expand Down Expand Up @@ -727,20 +727,20 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp,
isd, ied, jsd, jed+1, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
call regional_boundary_update(uc, 'uc', &
isd, ied+1, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
call mpp_update_domains(uc, vc, domain, gridtype=CGRID_NE)
!!! Currently divgd is always 0.0 in the regional domain boundary area.
reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+(it-1)*dt
call regional_boundary_update(divgd, 'divgd', &
isd, ied+1, jsd, jed+1, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
endif

if ( flagstruct%inline_q ) then
Expand All @@ -758,7 +758,7 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp,
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
enddo
endif

Expand Down Expand Up @@ -996,20 +996,20 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp,
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
#ifndef SW_DYNAMICS
call regional_boundary_update(pt, 'pt', &
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )

#ifdef USE_COND
call regional_boundary_update(q_con, 'q_con', &
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
#endif

#endif
Expand Down Expand Up @@ -1329,27 +1329,27 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp,

if (flagstruct%regional) then

reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+it*dt
#ifndef SW_DYNAMICS
if (.not. hydrostatic) then
reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+it*dt
call regional_boundary_update(w, 'w', &
isd, ied, jsd, jed, ubound(w,3), &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
endif
#endif SW_DYNAMICS

call regional_boundary_update(u, 'u', &
isd, ied, jsd, jed+1, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )
call regional_boundary_update(v, 'v', &
isd, ied+1, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,it )

call mpp_update_domains(u, v, domain, gridtype=DGRID_NE)

Expand Down
2 changes: 1 addition & 1 deletion model/fv_dynamics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -803,7 +803,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill,
isd, ied, jsd, jed, npz, &
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time )
reg_bc_update_time,1 )
endif
#endif

Expand Down
59 changes: 28 additions & 31 deletions model/fv_regional_bc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -383,18 +383,12 @@ subroutine setup_regional_BC(Atm &
file_name='INPUT/gfs_bndy.tile7.'//int_to_char//'_gsi.nc' !<-- The DA-updated BC file.
endif
!
if (is_master()) then
write(*,20011)trim(file_name)
20011 format(' regional_bc_data file_name=',a)
endif
!-----------------------------------------------------------------------
!*** Open the regional BC file.
!-----------------------------------------------------------------------
!
call check(nf90_open(file_name,nf90_nowrite,ncid)) !<-- Open the BC file; get the file ID.
if (is_master()) then
write(0,*)' opened BC file ',trim(file_name)
endif
call mpp_error(NOTE, 'Opened BC file: '//trim(file_name))
!
!-----------------------------------------------------------------------
!*** Check if the desired number of blending rows are present in
Expand Down Expand Up @@ -1075,7 +1069,7 @@ subroutine read_regional_lon_lat
!
call check(nf90_open(filename,nf90_nowrite,ncid_grid)) !<-- Open the grid data netcdf file; get the file ID.
!
call mpp_error(NOTE,' opened grid file '//trim(filename))
call mpp_error(NOTE, 'Opened grid file: '//trim(filename))
!
!-----------------------------------------------------------------------
!*** The longitude and latitude are on the super grid. We need only
Expand Down Expand Up @@ -1170,12 +1164,9 @@ subroutine read_regional_filtered_topo
!
filename='INPUT/'//trim(oro_data)

if (is_master()) then
write(*,23421)trim(filename)
23421 format(' topo filename=',a)
endif
!
call check(nf90_open(filename,nf90_nowrite,ncid_oro)) !<-- Open the netcdf file; get the file ID.
call mpp_error(NOTE, 'Opened topo file: '//trim(filename))
!
!-----------------------------------------------------------------------
!*** Read in the data including the extra outer row.
Expand Down Expand Up @@ -1661,19 +1652,13 @@ subroutine regional_bc_data(Atm,bc_hour &
file_name='INPUT/gfs_bndy.tile7.'//int_to_char//'_gsi.nc' !<-- The DA-updated BC file.
endif
!
if (is_master()) then
write(*,22211)trim(file_name)
22211 format(' regional_bc_data file_name=',a)
endif
!-----------------------------------------------------------------------
!*** Open the regional BC file.
!*** Find the # of layers (klev_in) in the BC input.
!-----------------------------------------------------------------------
!
call check(nf90_open(file_name,nf90_nowrite,ncid)) !<-- Open the BC file; get the file ID.
if (is_master()) then
write(0,*)' opened BC file ',trim(file_name)
endif
call mpp_error(NOTE, 'Opened BC file: '//trim(file_name))
!
call check(nf90_inq_dimid(ncid,'lev',dimid)) !<-- Get the vertical dimension's NetCDF ID.
call check(nf90_inquire_dimension(ncid,dimid,len=klev_in)) !<-- Get the vertical dimension's value (klev_in).
Expand Down Expand Up @@ -3305,7 +3290,9 @@ subroutine read_regional_bc_file(is_input,ie_input &
call check(status)
endif
if (status /= nf90_noerr) then
if (east_bc.and.is_master()) write(0,*)' WARNING: Tracer ',trim(var_name),' not in input file'
if (east_bc) then
call mpp_error(NOTE, 'Tracer '//trim(var_name)//' not in input file')
endif
array_4d(:,:,:,tlev)=0. !<-- Tracer not in input so set to zero in boundary.
!
blend_this_tracer(tlev)=.false. !<-- Tracer not in input so do not apply blending.
Expand Down Expand Up @@ -3877,7 +3864,6 @@ subroutine remap_scalar_nggps_regional_bc(Atm &
enddo
! call pmaxmn('PS_diff (mb)', wk, is, ie, js, je, 1, 0.01, Atm%gridstruct%area_64, Atm%domain)
deallocate (pe0,qn1,dp2,pe1,qp)
if (is_master()) write(*,*) 'done remap_scalar_nggps_regional_bc'
!---------------------------------------------------------------------

end subroutine remap_scalar_nggps_regional_bc
Expand Down Expand Up @@ -3997,8 +3983,6 @@ subroutine remap_dwinds_regional_bc(Atm &
deallocate(qn1_d)
deallocate(qn1_c)

if (is_master()) write(*,*) 'done remap_dwinds'

end subroutine remap_dwinds_regional_bc

!---------------------------------------------------------------------
Expand Down Expand Up @@ -4314,7 +4298,7 @@ subroutine regional_boundary_update(array &
,is,ie,js,je &
,isd,ied,jsd,jed &
,fcst_time &
,index4 )
,it,index4 )
!
!---------------------------------------------------------------------
!*** Select the given variable's boundary data at the two
Expand All @@ -4332,7 +4316,8 @@ subroutine regional_boundary_update(array &
integer,intent(in) :: lbnd_x,ubnd_x,lbnd_y,ubnd_y,ubnd_z !<-- Dimensions of full prognostic array to be updated.
!
integer,intent(in) :: is,ie,js,je & !<-- Compute limits
,isd,ied,jsd,jed !<-- Memory limits
,isd,ied,jsd,jed & !<-- Memory limits
,it !<-- Acoustic step
!
integer,intent(in),optional :: index4 !<-- Index for the 4-D tracer array.
!
Expand Down Expand Up @@ -4588,7 +4573,7 @@ subroutine regional_boundary_update(array &
,fcst_time &
,bc_update_interval &
,i1_blend,i2_blend,j1_blend,j2_blend &
,i_bc,j_bc,nside,bc_vbl_name,blend )
,i_bc,j_bc,nside,bc_vbl_name,blend,it )
endif
!
!---------------------------------------------------------------------
Expand Down Expand Up @@ -4718,7 +4703,7 @@ subroutine bc_time_interpolation(array &
,fcst_time &
,bc_update_interval &
,i1_blend,i2_blend,j1_blend,j2_blend &
,i_bc,j_bc,nside,bc_vbl_name,blend )
,i_bc,j_bc,nside,bc_vbl_name,blend,it )

!---------------------------------------------------------------------
!*** Update the boundary region of the input array at the given
Expand All @@ -4743,7 +4728,7 @@ subroutine bc_time_interpolation(array &
!
integer,intent(in) :: is,ie,js,je !<-- Min/Max index limits on task's computational subdomain
!
integer,intent(in) :: bc_update_interval !<-- Time (hours) between BC data states
integer,intent(in) :: bc_update_interval,it !<-- Time (hours) between BC data states, acoustic step
!
real,intent(in) :: fcst_time !<-- Current forecast time (sec)
!
Expand Down Expand Up @@ -4780,6 +4765,19 @@ subroutine bc_time_interpolation(array &
!
fraction_interval=mod(fcst_time,(bc_update_interval*3600.)) &
/(bc_update_interval*3600.)

!---------------------------------------------------------------------
!*** Special check for final acoustic step prior to new boundary information
!*** being ingested.
!---------------------------------------------------------------------

if (fraction_interval .eq. 0.0 .and. it .gt. 1) then
fraction_interval=1.0
if (is_master()) then
write(0,*) 'reset of fraction_interval ', trim(bc_vbl_name),it, fcst_time
endif
endif

!
!---------------------------------------------------------------------
!
Expand Down Expand Up @@ -6741,7 +6739,7 @@ subroutine get_data_source(data_source_fv3gfs,regional)
logical, intent(out):: data_source_fv3gfs

character (len=80) :: source
logical :: lstatus
logical :: lstatus = .false.
type(FmsNetcdfFile_t) :: Gfs_data
integer, allocatable, dimension(:) :: pes !< Array of the pes in the current pelist
!
Expand All @@ -6764,7 +6762,7 @@ subroutine get_data_source(data_source_fv3gfs,regional)
if (mpp_pe() == 0) write(0,*) 'INPUT source not found ',lstatus,' set source=No Source Attribute'
source='No Source Attribute'
endif
if (mpp_pe()==0) write(*,*) 'INPUT gfs_data source string=',source
call mpp_error(NOTE, 'INPUT gfs_data source string: '//trim(source))

! Logical flag for fv3gfs nemsio/netcdf/grib2 --------
if ( trim(source)=='FV3GFS GAUSSIAN NEMSIO FILE' .or. &
Expand All @@ -6774,7 +6772,6 @@ subroutine get_data_source(data_source_fv3gfs,regional)
else
data_source_fv3gfs = .FALSE.
endif
if (mpp_pe()==0) write(*,*) 'data_source_fv3gfs=',data_source_fv3gfs

end subroutine get_data_source

Expand Down
2 changes: 1 addition & 1 deletion model/fv_tracer2d.F90
Original file line number Diff line number Diff line change
Expand Up @@ -764,7 +764,7 @@ subroutine tracer_2d_nested(q, dp1, mfx, mfy, cx, cy, gridstruct, bd, domain, np
is, ie, js, je, &
isd, ied, jsd, jed, &
reg_bc_update_time, &
iq )
it, iq )
enddo
endif

Expand Down
Loading