Skip to content

Commit

Permalink
Update to the latest noaa-gfdl dev/emc branch (#69)
Browse files Browse the repository at this point in the history 
* Add get_nth_domain_info subroutine

* Deallocate local arrays in fv_dyn_bundle_setup

* adding back a line that was mistakenly deleted in a previous commit (NOAA-GFDL#166)

* Do not print debug messages to stderr

* fix for 4diau with iau_filter_increments=T (NOAA-GFDL#167)

* fix for 4diau with iau_filter_increments=T

* fix time interval for 3DIAU

* fix typo in comment

* fix bug found in review by @MingjingTong-NOAA

* change tnext to integer variable itnext

Co-authored-by: jswhit2 <Jeffrey.S.Whitaker@noaa.gov>

* Use mpp_error instead of write statements in model/fv_regional_bc.F90

* Attempt at integrating fixes on top of dev/emc branch. (NOAA-GFDL#173)

Co-authored-by: Dusan Jovic <dusan.jovic@noaa.gov>
Co-authored-by: laurenchilutti <60401591+laurenchilutti@users.noreply.github.com>
Co-authored-by: Jeff Whitaker <jswhit@fastmail.fm>
Co-authored-by: jswhit2 <Jeffrey.S.Whitaker@noaa.gov>
Co-authored-by: MatthewPyle-NOAA <48285220+MatthewPyle-NOAA@users.noreply.github.com>
  • Loading branch information
@MinsukJi-NOAA @DusanJovic-NOAA
@laurenchilutti @jswhit @jswhit2 @MatthewPyle-NOAA
6 people authored Mar 2, 2022
1 parent 2f88d44 commit c0d57b9
Show file tree
Hide file tree
Showing 7 changed files with 88 additions and 63 deletions.
22 changes: 20 additions & 2 deletions driver/fvGFS/atmosphere.F90
View file
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
View file
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
View file
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
View file
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
View file
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
View file
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

0 comments on commit c0d57b9

Please sign in to comment.