diff --git a/cmake/compiler_flags_Intel_Fortran.cmake b/cmake/compiler_flags_Intel_Fortran.cmake index 743afce35..0cfc70397 100644 --- a/cmake/compiler_flags_Intel_Fortran.cmake +++ b/cmake/compiler_flags_Intel_Fortran.cmake @@ -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") diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index 31aaa62a1..d4881c23d 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -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 diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index 8b672e1fa..ba098334d 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -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 @@ -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!') @@ -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 @@ -4085,7 +4086,7 @@ subroutine set_regional_BCs(delp,delz,w,pt & #endif ,q & ,u,v,uc,vc & - ,bd, nlayers & + ,bd, nlayers & ,fcst_time ) ! !--------------------------------------------------------------------- @@ -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 @@ -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. ! @@ -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 @@ -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 @@ -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 @@ -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 @@ -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)) @@ -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' @@ -6934,7 +6934,7 @@ 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) @@ -6942,13 +6942,13 @@ subroutine get_lbc_source(lbc_source_fv3gfs,regional) 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)) diff --git a/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index 787edefa9..f79f5f919 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -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 @@ -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 diff --git a/tools/module_diag_hailcast.F90 b/tools/module_diag_hailcast.F90 index 3fe4c411a..c3adbe5e6 100644 --- a/tools/module_diag_hailcast.F90 +++ b/tools/module_diag_hailcast.F90 @@ -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 diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 420958149..49f86589e 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -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 @@ -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 @@ -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 @@ -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