Skip to content

Commit

Permalink
Address compiler warnings for FV3 raised in an issue (NOAA-GFDL#324)
Browse files Browse the repository at this point in the history 
* give istatus a value on exit from hailcast_init

* fix issues with declared out variables in test_cases.F90

* fix out of range default integers, eol spaces, and remove delz argument from set_regional_BCs in fv_regional_bc.F90

* removed -nowarn from Intel compiler flags

* added suggested ifdef to remove goto warning as per operations
  • Loading branch information
@bensonr
bensonr authored Apr 17, 2024
1 parent 0301022 commit 9711488
Show file tree
Hide file tree
Showing 6 changed files with 34 additions and 23 deletions.
2 changes: 1 addition & 1 deletion cmake/compiler_flags_Intel_Fortran.cmake
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ set(R8_flags "-real-size 64") # Fortran flags for 64BIT precision
set(R8_flags "${R8_flags} -no-prec-div -no-prec-sqrt")

# Intel Fortran
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback -fpp -fno-alias -auto -safe-cray-ptr -ftz -assume byterecl -nowarn -sox -align array64byte -qno-opt-dynamic-align ${${kind}_flags}")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback -fpp -fno-alias -auto -safe-cray-ptr -ftz -assume byterecl -sox -align array64byte -qno-opt-dynamic-align ${${kind}_flags}")

set(CMAKE_Fortran_FLAGS_REPRO "-O2 -debug minimal -fp-model consistent -qoverride-limits")

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 @@ -378,7 +378,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill,

reg_bc_update_time=current_time_in_seconds
call set_regional_BCs & !<-- Insert values into the boundary region valid for the start of this large timestep.
(delp,delz,w,pt &
(delp,w,pt &
#ifdef USE_COND
,q_con &
#endif
Expand Down
36 changes: 18 additions & 18 deletions model/fv_regional_bc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,7 @@ module fv_regional_mod
integer,parameter :: bc_time_interval=3 &
,nhalo_data =4 &
,nhalo_model=3
integer, public, parameter :: int_init_default = -9999999
!
integer, public, parameter :: H_STAGGER = 1
integer, public, parameter :: U_STAGGER = 2
Expand Down Expand Up @@ -471,7 +472,7 @@ subroutine setup_regional_BC(Atm &
else
nrows_blend=nrows_blend_in_data !<-- # of blending rows in the BC files.
endif

IF ( north_bc .or. south_bc ) THEN
IF ( nrows_blend_user > jed - nhalo_model - (jsd + nhalo_model) + 1 ) THEN
call mpp_error(FATAL,'Number of blending rows is greater than the north-south tile size!')
Expand Down Expand Up @@ -4076,7 +4077,7 @@ end subroutine remap_dwinds_regional_bc
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!---------------------------------------------------------------------

subroutine set_regional_BCs(delp,delz,w,pt &
subroutine set_regional_BCs(delp,w,pt &
#ifdef USE_COND
,q_con &
#endif
Expand All @@ -4085,7 +4086,7 @@ subroutine set_regional_BCs(delp,delz,w,pt &
#endif
,q &
,u,v,uc,vc &
,bd, nlayers &
,bd, nlayers &
,fcst_time )
!
!---------------------------------------------------------------------
Expand Down Expand Up @@ -4117,7 +4118,6 @@ subroutine set_regional_BCs(delp,delz,w,pt &
,pt
!
real,dimension(bd%isd:,bd%jsd:,1:),intent(out) :: w
real,dimension(bd%is:,bd%js:,1:),intent(out) :: delz
#ifdef USE_COND
real,dimension(bd%isd:,bd%jsd:,1:),intent(out) :: q_con
#endif
Expand Down Expand Up @@ -4404,7 +4404,7 @@ subroutine regional_boundary_update(array &
!
integer,intent(in) :: is,ie,js,je & !<-- Compute limits
,isd,ied,jsd,jed & !<-- Memory limits
,it !<-- Acoustic step
,it !<-- Acoustic step
!
integer,intent(in),optional :: index4 !<-- Index for the 4-D tracer array.
!
Expand Down Expand Up @@ -4494,7 +4494,7 @@ subroutine regional_boundary_update(array &
endif
j1_blend=js
j2_blend=js+nrows_blend_user-1
i_bc=-9e9
i_bc=int_init_default
j_bc=j2
!
endif
Expand Down Expand Up @@ -4544,7 +4544,7 @@ subroutine regional_boundary_update(array &
j2_blend=je+1
endif
j1_blend=j2_blend-nrows_blend_user+1
i_bc=-9e9
i_bc=int_init_default
j_bc=j1
!
endif
Expand Down Expand Up @@ -4601,7 +4601,7 @@ subroutine regional_boundary_update(array &
j2_blend=j2_blend+1
endif
i_bc=i2
j_bc=-9e9
j_bc=int_init_default
!
endif
endif
Expand Down Expand Up @@ -4660,7 +4660,7 @@ subroutine regional_boundary_update(array &
j2_blend=j2_blend+1
endif
i_bc=i1
j_bc=-9e9
j_bc=int_init_default
!
endif
endif
Expand Down Expand Up @@ -6892,10 +6892,10 @@ subroutine get_data_source(data_source_fv3gfs,regional)
if (.not. lstatus) then
if (mpp_pe() == 0) write(0,*) 'INPUT source not found ',lstatus,' set source=No Source Attribute'
source='No Source Attribute'
call mpp_error(FATAL,'fv_regional_bc::get_data_source - input source not &
found in file gfs_data.nc. The accepted &
call mpp_error(FATAL,'fv_regional_bc::get_data_source - input source not &
found in file gfs_data.nc. The accepted &
FV3 sources are "FV3GFS GAUSSIAN NEMSIO FILE", &
"FV3GFS GAUSSIAN NETCDF FILE" or "FV3GFS GRIB2 FILE".')
"FV3GFS GAUSSIAN NETCDF FILE" or "FV3GFS GRIB2 FILE".')
endif
call mpp_error(NOTE, 'INPUT gfs_data source string: '//trim(source))

Expand Down Expand Up @@ -6925,7 +6925,7 @@ subroutine get_lbc_source(lbc_source_fv3gfs,regional)
character (len=80) :: source
logical :: lstatus = .false.
type(FmsNetcdfFile_t) :: Gfs_data
integer, allocatable, dimension(:) :: pes !< Array of the pes in the current pelist
integer, allocatable, dimension(:) :: pes !< Array of the pes in the current pelist
!
! Use the fms call here so we can actually get the return code value.
! The term 'source' is specified by 'chgres_cube'
Expand All @@ -6934,21 +6934,21 @@ subroutine get_lbc_source(lbc_source_fv3gfs,regional)
allocate(pes(mpp_npes()))
call mpp_get_current_pelist(pes)

if (open_file(Gfs_data , 'INPUT/gfs_bndy.tile7.000.nc', "read", pelist=pes)) then
if (open_file(Gfs_data , 'INPUT/gfs_bndy.tile7.000.nc', "read", pelist=pes)) then
lstatus = global_att_exists(Gfs_data, "source")
if(lstatus) call get_global_attribute(Gfs_data, "source", source)
call close_file(Gfs_data)
endif

deallocate(pes)
if (.not. lstatus) then
if (mpp_pe() == 0) write(0,*) 'INPUT source not found ',lstatus,' set source=No Source Attribute'
if (mpp_pe() == 0) write(0,*) 'INPUT source not found ',lstatus,' set source=No Source Attribute'
source='No Source Attribute'
call mpp_error(FATAL,'fv_regional_bc::get_lbc_source - input source not &
call mpp_error(FATAL,'fv_regional_bc::get_lbc_source - input source not &
found in file &
gfs_bndy.tile7.000.nc. The accepted &
gfs_bndy.tile7.000.nc. The accepted &
FV3 sources are "FV3GFS GAUSSIAN NEMSIO FILE", &
"FV3GFS GAUSSIAN NETCDF FILE" or "FV3GFS GRIB2 FILE".')
"FV3GFS GAUSSIAN NETCDF FILE" or "FV3GFS GRIB2 FILE".')
endif
call mpp_error(NOTE, 'INPUT gfs_bndy source string: '//trim(source))

Expand Down
5 changes: 5 additions & 0 deletions tools/fv_nudge.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2273,6 +2273,10 @@ subroutine breed_slp_inline(nstep, dt, npz, ak, bk, phis, pe, pk, peln, pkz, del
real :: kappax(is:ie,js:je,npz)
#endif

#if defined (BYPASS_BREED_SLP_INLINE)
peln = 0.0 ! to silence compiler warning. A dummy argument with an explicit INTENT(OUT) declaration is not given an explicit value.
call mpp_error(fatal, "breed_slp_inline routine has been disabled")
#else
if ( forecast_mode ) return

agrid => gridstruct%agrid_64
Expand Down Expand Up @@ -2715,6 +2719,7 @@ subroutine breed_slp_inline(nstep, dt, npz, ak, bk, phis, pe, pk, peln, pkz, del

nullify(agrid)
nullify(area)
#endif

end subroutine breed_slp_inline

Expand Down
5 changes: 5 additions & 0 deletions tools/module_diag_hailcast.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,11 @@ SUBROUTINE hailcast_init(file_name, axes, Time, isco,ieco,jsco,jeco,&
!write(unit, nml=fv_diagnostics_nml)
!!end hailcast nml


! need to set a default value for istatus because of it's intent(out) status
! this value is not checked on return
istatus = 0

if (mpp_pe() == mpp_root_pe()) then
print*, 'do_hailcast = ', do_hailcast
end if
Expand Down
7 changes: 4 additions & 3 deletions tools/test_cases.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3192,7 +3192,7 @@ subroutine init_case(u,v,w,pt,delp,q,phis, ps,pe,peln,pk,pkz, uc,vc, ua,va, ak,
! Iterate then interpolate to get balanced pt & pk on the sphere
! Adjusting ptop
call SuperK_u(npz, zs1, uz1, dudz)
call balanced_K(npz, is, ie, js, je, ng, pe1(npz+1), ze1, ts1, qs1, uz1, dudz, pe, pk, pt, &
call balanced_K(npz, is, ie, js, je, ng, pe1(npz+1), ze1, ts1, qs1, uz1, dudz, pe, pt, &
delz, zvir, ptop, ak, bk, agrid)
do j=js,je
do i=is,ie
Expand Down Expand Up @@ -5464,7 +5464,7 @@ subroutine SuperK_Sounding(km, pe, p00, ze, pt, qz)

end subroutine SuperK_Sounding

subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe, pk, pt, &
subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe, pt, &
delz, zvir, ptop, ak, bk, agrid)
integer, intent(in):: is, ie, js, je, ng, km
real, intent(in), dimension(km ):: ts1, qs1, uz1, dudz
Expand All @@ -5475,7 +5475,6 @@ subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe,
real, intent(inout), dimension(km+1):: ak, bk
real, intent(inout), dimension(is:ie,js:je,km):: pt
real, intent(inout), dimension(is:,js:,1:) :: delz
real, intent(out), dimension(is:ie,js:je,km+1):: pk
! pt is FV's cp*thelta_v
real, intent(inout), dimension(is-1:ie+1,km+1,js-1:je+1):: pe
! Local
Expand Down Expand Up @@ -5683,6 +5682,8 @@ subroutine SuperCell_Sounding(km, ps, pk1, tp, qp)
#ifdef GFS_PHYS

call mpp_error(FATAL, 'SuperCell sounding cannot perform with GFS Physics.')
tp=0.
qp=0.

#else

Expand Down

0 comments on commit 9711488

Please sign in to comment.