Skip to content

Commit

Permalink
* Fixes for GNU compilation issues (NOAA-GFDL#32)
Browse files Browse the repository at this point in the history
* Fixes for mesh generation in init_grid (NOAA-GFDL#39)
* Remove trailing whitespace and any tabs
* Add default values for nest_*offsets in fv_control
  • Loading branch information
XiaqiongZhou-NOAA committed Jun 15, 2020
1 parent 3ff1ed2 commit 4e598ed
Show file tree
Hide file tree
Showing 9 changed files with 60 additions and 61 deletions.
8 changes: 4 additions & 4 deletions model/boundary.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2365,7 +2365,7 @@ subroutine update_coarse_grid_mpp(var_coarse, var_nest, nest_domain, dx, dy, are
position = CENTER
end if

!Note that *_c does not have values on the parent_proc.
!Note that *_c does not have values on the parent_proc.
!Must use isu, etc. to get bounds of update region on parent.
call mpp_get_F2C_index(nest_domain, is_c, ie_c, js_c, je_c, is_f, ie_f, js_f, je_f, nest_level=nest_level, position=position)
if (child_proc) then
Expand Down Expand Up @@ -2536,7 +2536,7 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed
select case (nestupdate)
case (1,2,6,7,8) ! 1 = Conserving update on all variables; 2 = conserving update for cell-centered values; 6 = conserving remap-update

!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
do k=1,npz
do j=jsu,jeu
do i=isu,ieu
Expand All @@ -2559,7 +2559,7 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed
select case (nestupdate)
case (1,6,7,8)

!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
do k=1,npz
do j=jsu,jeu+1
do i=isu,ieu
Expand All @@ -2579,7 +2579,7 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed
select case (nestupdate)
case (1,6,7,8) !averaging update; in-line average for face-averaged values instead of areal average

!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse)
do k=1,npz
do j=jsu,jeu
do i=isu,ieu+1
Expand Down
9 changes: 4 additions & 5 deletions model/fv_control.F90
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,7 @@ module fv_control_mod
use fv_mp_mod, only: mp_start, domain_decomp, mp_assign_gid, global_nest_domain
use fv_mp_mod, only: broadcast_domains, mp_barrier, is_master, setup_master, grids_master_procs, tile_fine
use fv_mp_mod, only: MAX_NNEST, MAX_NTILE
!use test_cases_mod, only: test_case, bubble_do, alpha, nsolitons, soliton_Umax, soliton_size
use test_cases_mod, only: read_namelist_test_case_nml
use fv_timing_mod, only: timing_on, timing_off, timing_init, timing_prt
use mpp_domains_mod, only: domain2D
use mpp_domains_mod, only: mpp_define_nest_domains, nest_domain_type, mpp_get_global_domain
Expand Down Expand Up @@ -200,7 +200,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split)
integer, dimension(MAX_NNEST) :: grid_pes = 0
integer, dimension(MAX_NNEST) :: grid_coarse = -1
integer, dimension(MAX_NNEST) :: nest_refine = 3
integer, dimension(MAX_NNEST) :: nest_ioffsets, nest_joffsets
integer, dimension(MAX_NNEST) :: nest_ioffsets = -999, nest_joffsets = -999
integer, dimension(MAX_NNEST) :: all_npx = 0
integer, dimension(MAX_NNEST) :: all_npy = 0
integer, dimension(MAX_NNEST) :: all_npz = 0
Expand Down Expand Up @@ -537,7 +537,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split)
#endif
call read_namelist_fv_grid_nml
call read_namelist_fv_core_nml(Atm(this_grid)) ! do options processing here too?
!TODO test_case_nml moved to test_cases
call read_namelist_test_case_nml(Atm(this_grid)%nml_filename)
call mpp_get_current_pelist(Atm(this_grid)%pelist, commID=commID) ! for commID
call mp_start(commID,halo_update_type)

Expand Down Expand Up @@ -679,7 +679,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split)

endif

allocate(Atm(this_grid)%neststruct%child_grids(ngrids))
allocate(Atm(this_grid)%neststruct%child_grids(ngrids))
do n=1,ngrids
Atm(this_grid)%neststruct%child_grids(n) = (grid_coarse(n) == this_grid)
allocate(Atm(n)%neststruct%do_remap_bc(ngrids))
Expand Down Expand Up @@ -1218,7 +1218,6 @@ subroutine setup_update_regions
upoff = Atm(this_grid)%neststruct%upoff

do n=2,ngrids
write(*,'(I, A, 4I)') mpp_pe(), 'SETUP_UPDATE_REGIONS 0: ', mpp_pe(), tile_coarse(n), Atm(this_grid)%global_tile
if (tile_coarse(n) == Atm(this_grid)%global_tile) then

isu = nest_ioffsets(n)
Expand Down
2 changes: 1 addition & 1 deletion model/fv_nesting.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1870,7 +1870,7 @@ end subroutine set_BCs_t0

subroutine d2c_setup(u, v, &
ua, va, &
uc, vc, dord4, &
uc, vc, dord4, &
isd,ied,jsd,jed, is,ie,js,je, npx,npy, &
grid_type, bounded_domain, &
se_corner, sw_corner, ne_corner, nw_corner, &
Expand Down
4 changes: 2 additions & 2 deletions model/tp_core.F90
Original file line number Diff line number Diff line change
Expand Up @@ -159,7 +159,7 @@ subroutine fv_tp_2d(q, crx, cry, npx, npy, hord, fx, fy, xfx, yfx, &
ord_ou = hord

if (.not. gridstruct%bounded_domain) &
call copy_corners(q, npx, npy, 2, gridstruct%bounded_domain, bd, &
call copy_corners(q, npx, npy, 2, gridstruct%bounded_domain, bd, &
gridstruct%sw_corner, gridstruct%se_corner, gridstruct%nw_corner, gridstruct%ne_corner)

call yppm(fy2, q, cry, ord_in, isd,ied,isd,ied, js,je,jsd,jed, npx,npy, gridstruct%dya, gridstruct%bounded_domain, gridstruct%grid_type, lim_fac)
Expand All @@ -178,7 +178,7 @@ subroutine fv_tp_2d(q, crx, cry, npx, npy, hord, fx, fy, xfx, yfx, &
call xppm(fx, q_i, crx(is,js), ord_ou, is,ie,isd,ied, js,je,jsd,jed, npx,npy, gridstruct%dxa, gridstruct%bounded_domain, gridstruct%grid_type, lim_fac)

if (.not. gridstruct%bounded_domain) &
call copy_corners(q, npx, npy, 1, gridstruct%bounded_domain, bd, &
call copy_corners(q, npx, npy, 1, gridstruct%bounded_domain, bd, &
gridstruct%sw_corner, gridstruct%se_corner, gridstruct%nw_corner, gridstruct%ne_corner)

call xppm(fx2, q, crx, ord_in, is,ie,isd,ied, jsd,jed,jsd,jed, npx,npy, gridstruct%dxa, gridstruct%bounded_domain, gridstruct%grid_type, lim_fac)
Expand Down
4 changes: 2 additions & 2 deletions tools/external_ic.F90
Original file line number Diff line number Diff line change
Expand Up @@ -810,15 +810,15 @@ subroutine get_nggps_ic (Atm, fv_domain, dt_atmos )
Atm%gridstruct%dxc, Atm%gridstruct%dyc, Atm%gridstruct%sin_sg, &
Atm%flagstruct%n_zs_filter, cnst_0p20*Atm%gridstruct%da_min, &
.false., oro_g, Atm%gridstruct%bounded_domain, &
Atm%domain, Atm%bd)
Atm%domain, Atm%bd)
if ( is_master() ) write(*,*) 'Warning !!! del-2 terrain filter has been applied ', &
Atm%flagstruct%n_zs_filter, ' times'
else if( Atm%flagstruct%nord_zs_filter == 4 ) then
call del4_cubed_sphere(Atm%npx, Atm%npy, Atm%phis, Atm%gridstruct%area_64, &
Atm%gridstruct%dx, Atm%gridstruct%dy, &
Atm%gridstruct%dxc, Atm%gridstruct%dyc, Atm%gridstruct%sin_sg, &
Atm%flagstruct%n_zs_filter, .false., oro_g, &
Atm%gridstruct%bounded_domain, &
Atm%gridstruct%bounded_domain, &
Atm%domain, Atm%bd)
if ( is_master() ) write(*,*) 'Warning !!! del-4 terrain filter has been applied ', &
Atm%flagstruct%n_zs_filter, ' times'
Expand Down
2 changes: 1 addition & 1 deletion tools/fv_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2036,7 +2036,7 @@ subroutine fv_diag(Atm, zvir, Time, print_freq)



if( idiag%id_slp>0 .or. idiag%id_tm>0 .or. idiag%id_any_hght>0 .or. idiag%id_hght3d .or. idiag%id_c15>0 .or. idiag%id_ctz ) then
if( idiag%id_slp>0 .or. idiag%id_tm>0 .or. idiag%id_any_hght>0 .or. idiag%id_hght3d>0 .or. idiag%id_c15>0 .or. idiag%id_ctz>0 ) then

allocate ( wz(isc:iec,jsc:jec,npz+1) )
call get_height_field(isc, iec, jsc, jec, ngc, npz, Atm(n)%flagstruct%hydrostatic, Atm(n)%delz, &
Expand Down
4 changes: 2 additions & 2 deletions tools/fv_grid_tools.F90
Original file line number Diff line number Diff line change
Expand Up @@ -709,8 +709,8 @@ subroutine init_grid(Atm, grid_name, grid_file, npx, npy, npz, ndims, nregions,
!----------------------------------------------------------------------------------------------------
if ( grid_global(i,j,1,n) < 0. ) &
grid_global(i,j,1,n) = grid_global(i,j,1,n) + 2.*pi
if (ABS(grid_global(i,j,1,1)) < 1.d-10) grid_global(i,j,1,1) = 0.0
if (ABS(grid_global(i,j,2,1)) < 1.d-10) grid_global(i,j,2,1) = 0.0
if (ABS(grid_global(i,j,1,n)) < 1.d-10) grid_global(i,j,1,n) = 0.0
if (ABS(grid_global(i,j,2,n)) < 1.d-10) grid_global(i,j,2,n) = 0.0
enddo
enddo
enddo
Expand Down
4 changes: 2 additions & 2 deletions tools/fv_restart.F90
Original file line number Diff line number Diff line change
Expand Up @@ -541,7 +541,7 @@ subroutine fv_restart(fv_domain, Atm, dt_atmos, seconds, days, cold_start, grid_


do n = ntileMe,1,-1
if (new_nest_topo(n)) then
if (new_nest_topo(n) > 0 ) then
call twoway_topo_update(Atm(n), n==this_grid)
endif
end do
Expand All @@ -566,7 +566,7 @@ subroutine fv_restart(fv_domain, Atm, dt_atmos, seconds, days, cold_start, grid_
ntdiag = size(Atm(n)%qdiag,4)


if (.not. ideal_test_case(n)) then
if ( ideal_test_case(n) == 0 ) then
#ifdef SW_DYNAMICS
Atm(n)%pt(:,:,:)=1.
#else
Expand Down
84 changes: 42 additions & 42 deletions tools/test_cases.F90
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,7 @@ module test_cases_mod
integer, parameter :: interpOrder = 1

public :: pz0, zz0
public :: test_case, bubble_do, alpha, tracer_test, wind_field, nsolitons, soliton_Umax, soliton_size
public :: read_namelist_test_case_nml, alpha
public :: init_case
#ifdef NCDF_OUTPUT
public :: output, output_ncdf
Expand Down Expand Up @@ -6360,26 +6360,26 @@ subroutine init_double_periodic(u,v,w,pt,delp,q,phis, ps,pe,peln,pk,pkz, uc,vc,
call hydro_eq(npz, is, ie, js, je, ps, phis, dry_mass, &
delp, ak, bk, pt, delz, area, ng, .false., hydrostatic, hybrid_z, domain)

! *** Add Initial perturbation ***
if (bubble_do) then
r0 = 100.*sqrt(dx_const**2 + dy_const**2)
icenter = npx/2
jcenter = npy/2

do j=js,je
do i=is,ie
dist = (i-icenter)*dx_const*(i-icenter)*dx_const &
+(j-jcenter)*dy_const*(j-jcenter)*dy_const
dist = min(r0, sqrt(dist))
do k=1,npz
prf = ak(k) + ps(i,j)*bk(k)
if ( prf > 100.E2 ) then
pt(i,j,k) = pt(i,j,k) + 0.01*(1. - (dist/r0)) * prf/ps(i,j)
endif
enddo
enddo
enddo
endif
! *** Add Initial perturbation ***
if (bubble_do) then
r0 = 100.*sqrt(dx_const**2 + dy_const**2)
icenter = npx/2
jcenter = npy/2

do j=js,je
do i=is,ie
dist = (i-icenter)*dx_const*(i-icenter)*dx_const &
+(j-jcenter)*dy_const*(j-jcenter)*dy_const
dist = min(r0, sqrt(dist))
do k=1,npz
prf = ak(k) + ps(i,j)*bk(k)
if ( prf > 100.E2 ) then
pt(i,j,k) = pt(i,j,k) + 0.01*(1. - (dist/r0)) * prf/ps(i,j)
endif
enddo
enddo
enddo
endif
if ( hydrostatic ) then
call p_var(npz, is, ie, js, je, ptop, ptop_min, delp, delz, pt, ps, &
pe, peln, pk, pkz, kappa, q, ng, ncnst, area, dry_mass, .false., .false., &
Expand Down Expand Up @@ -6734,26 +6734,26 @@ subroutine init_double_periodic(u,v,w,pt,delp,q,phis, ps,pe,peln,pk,pkz, uc,vc,
.true., hydrostatic, nwat, domain, flagstruct%adiabatic)

! *** Add Initial perturbation ***
if (bubble_do) then
r0 = 10.e3
zc = 1.4e3 ! center of bubble from surface
icenter = (npx-1)/2 + 1
jcenter = (npy-1)/2 + 1
do k=1, npz
zm = 0.5*(ze1(k)+ze1(k+1))
ptmp = ( (zm-zc)/zc ) **2
if ( ptmp < 1. ) then
do j=js,je
do i=is,ie
dist = ptmp+((i-icenter)*dx_const/r0)**2+((j-jcenter)*dy_const/r0)**2
if ( dist < 1. ) then
pt(i,j,k) = pt(i,j,k) + pturb*(1.-sqrt(dist))
endif
enddo
enddo
endif
enddo
endif
if (bubble_do) then
r0 = 10.e3
zc = 1.4e3 ! center of bubble from surface
icenter = (npx-1)/2 + 1
jcenter = (npy-1)/2 + 1
do k=1, npz
zm = 0.5*(ze1(k)+ze1(k+1))
ptmp = ( (zm-zc)/zc ) **2
if ( ptmp < 1. ) then
do j=js,je
do i=is,ie
dist = ptmp+((i-icenter)*dx_const/r0)**2+((j-jcenter)*dy_const/r0)**2
if ( dist < 1. ) then
pt(i,j,k) = pt(i,j,k) + pturb*(1.-sqrt(dist))
endif
enddo
enddo
endif
enddo
endif

case ( 101 )

Expand Down Expand Up @@ -6904,14 +6904,14 @@ subroutine read_namelist_test_case_nml(nml_filename)
integer :: ierr, f_unit, unit, ios

#include<file_version.h>
namelist /test_case_nml/test_case, bubble_do, alpha, nsolitons,soliton_Umax, soliton_size

unit = stdlog()

! Make alpha = 0 the default:
alpha = 0.
bubble_do = .false.
test_case = 11 ! (USGS terrain)
namelist /test_case_nml/test_case, bubble_do, alpha, nsolitons, soliton_Umax, soliton_size

#ifdef INTERNAL_FILE_NML
! Read Test_Case namelist
Expand Down

0 comments on commit 4e598ed

Please sign in to comment.