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

Fixes for GNU compilation issues (from @XiaqiongZhou-NOAA) #22

Merged
merged 4 commits into from
Jun 22, 2020
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
4 changes: 2 additions & 2 deletions driver/fvGFS/atmosphere.F90
Original file line number Diff line number Diff line change
Expand Up @@ -944,14 +944,14 @@ subroutine atmosphere_hgt (hgt, position, relative, flip)
!--- if needed, flip the indexing during this step
if (flip) then
if (.not. relative) then
z(:,:,1) = Atm(mygrid)%phis(:,:)/grav
z(1:iec-isc+1,1:jec-jsc+1,1) = Atm(mygrid)%phis(isc:iec,jsc:jec)/grav
endif
do k = 2,npz+1
z(:,:,k) = z(:,:,k-1) - dz(:,:,npz+2-k)
enddo
else
if (.not. relative) then
z(:,:,npz+1) = Atm(mygrid)%phis(:,:)/grav
z(1:iec-isc+1,1:jec-jsc+1,npz+1) = Atm(mygrid)%phis(isc:iec,jsc:jec)/grav
endif
do k = npz,1,-1
z(:,:,k) = z(:,:,k+1) - dz(:,:,k)
Expand Down
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_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