Skip to content

Fix for nag compiler #618

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.

Sign up for GitHub

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

Draft
nmizukami wants to merge 2 commits into
base: main
Choose a base branch
from
Draft

Fix for nag compiler #618

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
2e3511a
add one spacing specified for X edit descriptor
nmizukami Mar 19, 2026
fb47d83
removed unused imorted objects and removed unused local variables
nmizukami Mar 19, 2026
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
22 changes: 11 additions & 11 deletions route/build/src/allocation.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,13 +19,13 @@ MODULE allocation
USE globalData, ONLY: meta_PFAF ! network topology

! named variables
USE var_lookup, ONLY: ixStruct, nStructures ! index of data structures
USE var_lookup, ONLY: ixDims, nDimensions ! index of dimensions
USE var_lookup, ONLY: ixHRU, nVarsHRU ! index of variables for the HRUs
USE var_lookup, ONLY: ixSEG, nVarsSEG ! index of variables for the stream segments
USE var_lookup, ONLY: ixHRU2SEG,nVarsHRU2SEG ! index of variables for the hru2segment mapping
USE var_lookup, ONLY: ixNTOPO, nVarsNTOPO ! index of variables for the network topology
USE var_lookup, ONLY: ixPFAF, nVarsPFAF ! index of variables for the pfafstetter code
USE var_lookup, ONLY: ixStruct, nStructures ! index of nStructures data structures
USE var_lookup, ONLY: ixDims ! index of dimensions
USE var_lookup, ONLY: ixSEG, nVarsSEG ! index of nVarsSEG variables for the stream segments
USE var_lookup, ONLY: ixNTOPO, nVarsNTOPO ! index of nVarsNTOPO variables for the network topology
USE var_lookup, ONLY: nVarsHRU ! number of variables for the HRUs
USE var_lookup, ONLY: nVarsHRU2SEG ! number of variables for the hru2segment mapping
USE var_lookup, ONLY: nVarsPFAF ! number of variables for the pfafstetter code

implicit none

Expand Down Expand Up @@ -71,18 +71,18 @@ SUBROUTINE alloc_struct(nHRU, & ! input: number of HRUs

! allocate the spatial dimension in all data structures
allocate(structHRU(nHRU), structHRU2seg(nHRU), structSeg(nSeg), structNTOPO(nSeg), structPFAF(nSeg), stat=ierr)
if(ierr/=0)then; ierr=20; message=trim(message)//'problem allocating [structHRU,structHRU2seg,structNTOPO,structPFAF]'; return; endif
if(ierr/=0)then; message=trim(message)//'problem allocating structHRU, structHRU2seg, structNTOPO or structPFAF'; return; endif

! allocate the variable dimension in the data structures with length nHRU
do iHRU=1,nHRU
allocate(structHRU(iHRU)%var(nVarsHRU), structHRU2seg(iHRU)%var(nVarsHRU2SEG), stat=ierr)
if(ierr/=0)then; ierr=20; message=trim(message)//'problem allocating variables for HRUs'; return; endif
if(ierr/=0)then; message=trim(message)//'problem allocating variables for HRUs'; return; endif
end do

! allocate the variable dimension in the data structures with length nSeg
do iSeg=1,nSeg
allocate(structSeg(iSeg)%var(nVarsSEG), structNTOPO(iSeg)%var(nVarsNTOPO), structPFAF(iSeg)%var(nVarsPFAF),stat=ierr)
if(ierr/=0)then; ierr=20; message=trim(message)//'problem allocating variables for stream segments'; return; endif
if(ierr/=0)then; message=trim(message)//'problem allocating var of structSeg,structNTOPO or structPFAF'; return; endif
end do

! ---------- allocate space for the scalar variables --------------------------------------------------------------
Expand Down Expand Up @@ -122,7 +122,7 @@ SUBROUTINE alloc_struct(nHRU, & ! input: number of HRUs
case(ixStruct%PFAF ); if(isDimScalar) allocate(structPFAF( iSpace)%var(iVar)%dat(1), stat=ierr)
case default; ierr=20; message=trim(message)//'unable to identify data structure'; return
end select
if(ierr/=0)then; ierr=20; message=trim(message)//'problem allocating space for the data vectors'; return; endif
if(ierr/=0)then; message=trim(message)//'problem allocating space for the data vectors'; return; endif

end do ! loop through variab;es
end do ! loop through space
Expand Down
2 changes: 0 additions & 2 deletions route/build/src/dataTypes.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@ MODULE dataTypes
! used to create specific data types

USE nrtype
USE public_var, ONLY: realMissing
USE public_var, ONLY: integerMissing
USE datetime_data, ONLY: datetime

Expand Down Expand Up @@ -427,7 +426,6 @@ END MODULE dataTypes
MODULE objTypes

USE nrtype
USE public_var, only: realMissing
USE public_var, only: integerMissing

! define derived type for model variables, including name, description, and units
Expand Down
3 changes: 1 addition & 2 deletions route/build/src/dfw_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ MODULE dfw_route_module
USE dataTypes, ONLY: dwRCH ! dw specific state data structure
USE public_var, ONLY: iulog ! i/o logical unit number
USE public_var, ONLY: realMissing ! missing value for real number
USE public_var, ONLY: integerMissing ! missing value for integer number
USE public_var, ONLY: desireId ! ID or reach where detailed reach state is print in log
USE public_var, ONLY: dt ! simulation time step [sec]
USE public_var, ONLY: is_flux_wm ! logical water management components fluxes should be read
Expand Down Expand Up @@ -191,7 +190,7 @@ SUBROUTINE dfw_rch(this, & ! dfw_route_rch object to bound this proced
RCHFLX_out, & ! inout: reach fluxes datq structure
ierr, cmessage) ! output: error control
if(ierr/=0)then
write(message,'(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
write(message,'(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
endif
end if

Expand Down
6 changes: 1 addition & 5 deletions route/build/src/domain_decomposition.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -493,8 +493,6 @@ SUBROUTINE classify_river_basin(nDivs, & ! input: number of divisions (
integer(i4b), allocatable :: HRUindex(:) ! local array for HRU indices
integer(i4b), allocatable :: ixEndorheic(:) ! local array for endorheic HRU indices
integer(i4b), allocatable :: index_array(:) ! local index array
integer(i4b) :: segIndex(nSeg) ! reach index for all the reaches
integer(i4b) :: downIndex(nSeg) ! downstream reach index for all the reacheds
logical(lgt) :: majorMainstem(nSeg) ! logical to indicate reach is "major" mainstem
integer(i4b) :: nUpSeg ! number of upstream reaches for a reach
integer(i4b) :: sumHruLocal ! sum of hrus that contribute to the segments
Expand All @@ -516,9 +514,7 @@ SUBROUTINE classify_river_basin(nDivs, & ! input: number of divisions (

! put ntopo data structure components into a separate array
do iSeg = 1, nSeg
segIndex(iSeg) = structNTOPO(iSeg)%var(ixNTOPO%segIndex)%dat(1)
downIndex(iSeg) = structNTOPO(iSeg)%var(ixNTOPO%downSegIndex)%dat(1)
nUpSeg = size(structNTOPO(iSeg)%var(ixNTOPO%allUpSegIndices)%dat)
nUpSeg = size(structNTOPO(iSeg)%var(ixNTOPO%allUpSegIndices)%dat)
if (nUpSeg > maxSegs) majorMainstem(iSeg) = .true.
enddo

Expand Down
1 change: 0 additions & 1 deletion route/build/src/hydraulic.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,6 @@ MODULE hydraulic
logical(lgt), parameter :: useFrictionSlope = .true. ! .false. -> approximate friction slope with channel slope
real(dp), parameter :: const13=1._dp/3._dp ! constant
real(dp), parameter :: const23=2._dp/3._dp ! constant
real(dp), parameter :: const43=4._dp/3._dp ! constant
real(dp), parameter :: const53=5._dp/3._dp ! constant
real(dp), parameter :: const103=10._dp/3._dp ! constant
real(dp), parameter :: err_thresh=0.005_dp ! newton method convergence threshold
Expand Down
3 changes: 1 addition & 2 deletions route/build/src/irf_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ MODULE irf_route_module
USE dataTypes, ONLY: irfRCH ! irf specific state data structure
USE public_var, ONLY: iulog ! i/o logical unit number
USE public_var, ONLY: realMissing ! missing value for real number
USE public_var, ONLY: integerMissing ! missing value for integer number
USE public_var, ONLY: desireId ! ID or reach where detailed reach state is print in log
USE public_var, ONLY: dt ! simulation time step [sec]
USE public_var, ONLY: qmodOption ! qmod option (use 1==direct insertion)
Expand Down Expand Up @@ -194,7 +193,7 @@ SUBROUTINE irf_rch(this, & ! irf_route_rch object to bound this procedur
RCHFLX_out, & ! inout: reach fluxes datq structure
ierr, cmessage) ! output: error control
if(ierr/=0)then
write(message,'(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
write(message,'(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
endif
end if

Expand Down
4 changes: 1 addition & 3 deletions route/build/src/kwe_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ MODULE kw_route_module
USE dataTypes, ONLY: kwRCH ! kw specific state data structure
USE public_var, ONLY: iulog ! i/o logical unit number
USE public_var, ONLY: realMissing ! missing value for real number
USE public_var, ONLY: integerMissing ! missing value for integer number
USE public_var, ONLY: desireId ! ID or reach where detailed reach state is print in log
USE public_var, ONLY: dt ! simulation time step [sec]
USE public_var, ONLY: is_flux_wm ! logical water management components fluxes should be read
Expand All @@ -24,7 +23,6 @@ MODULE kw_route_module
USE hydraulic, ONLY: flow_depth
USE hydraulic, ONLY: water_height
USE hydraulic, ONLY: celerity
USE hydraulic, ONLY: diffusivity
USE data_assimilation, ONLY: direct_insertion ! qmod option (use 1==direct insertion)

implicit none
Expand Down Expand Up @@ -190,7 +188,7 @@ SUBROUTINE kw_rch(this, & ! kwe_route_rch object to bound this procedu
RCHFLX_out, & ! inout: reach fluxes datq structure
ierr, cmessage) ! output: error control
if(ierr/=0)then
write(message,'(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
write(message,'(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
endif
end if

Expand Down
3 changes: 1 addition & 2 deletions route/build/src/lake_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ MODULE lake_route_module
USE public_var, ONLY: pi ! parameter: pi value of 3.14159265359_dp
USE globalData, ONLY: isColdStart ! parameter: restart flag
USE water_balance, ONLY: comp_reach_wb ! routine: compute water balance error
USE ascii_utils, ONLY: lower ! routine: convert string to lower case

implicit none
integer(i4b),parameter :: endorheic=0
Expand Down Expand Up @@ -65,7 +64,7 @@ SUBROUTINE lake_route(segIndex, & ! input: index of runoff reach to be proc
real(dp) :: c ! storage to yearly activity ratio
real(dp) :: I_yearly, D_yearly ! mean annual inflow and demand
real(dp), dimension(12) :: I_months, D_months ! mean monthly inflow and demand
integer(i4b), dimension(2) :: array_size(2) ! get the size of array_size
integer(i4b), dimension(2) :: array_size ! get the size of array_size
integer(i4b) :: start_month=0 ! start month of the operational year
integer(i4b) :: i ! index
integer(i4b) :: past_length_I ! pas length for inflow based on length in year and floor
Expand Down
1 change: 0 additions & 1 deletion route/build/src/main_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@ MODULE main_route_module
USE dataTypes, ONLY: STRFLX ! fluxes in each reach
USE dataTypes, ONLY: RCHTOPO ! Network topology
USE dataTypes, ONLY: RCHPRP ! Reach parameter
USE dataTypes, ONLY: runoff ! runoff data type
USE dataTypes, ONLY: subbasin_omp ! mainstem+tributary data structures
USE obs_data, ONLY: gageObs
USE globalData, ONLY: routeMethods ! Active routing method IDs
Expand Down
3 changes: 1 addition & 2 deletions route/build/src/mc_route.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ MODULE mc_route_module
USE dataTypes, ONLY: mcRCH ! MC specific state data structure
USE public_var, ONLY: iulog ! i/o logical unit number
USE public_var, ONLY: realMissing ! missing value for real number
USE public_var, ONLY: integerMissing ! missing value for integer number
USE public_var, ONLY: desireId ! ID or reach where detailed reach state is print in log
USE public_var, ONLY: dt ! simulation time step [sec]
USE public_var, ONLY: qmodOption ! qmod option (use 1==direct insertion)
Expand Down Expand Up @@ -189,7 +188,7 @@ SUBROUTINE mc_rch(this, & ! mc_route_rch object to bound this procedur
RCHFLX_out, & ! inout: reach fluxes datq structure
ierr, cmessage) ! output: error control
if(ierr/=0)then
write(message,'(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
write(message,'(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return
endif
end if

Expand Down
6 changes: 3 additions & 3 deletions route/build/src/nr_utils.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,12 +29,12 @@ MODULE nr_utils
END INTERFACE

INTERFACE char2int
module procedure :: char2int_1d
module procedure :: char2int_2d
module procedure char2int_1d
module procedure char2int_2d
END INTERFACE

INTERFACE match_index
module procedure :: match_index_i4b, match_index_i8b
module procedure match_index_i4b, match_index_i8b
END INTERFACE

private
Expand Down
4 changes: 0 additions & 4 deletions route/build/src/pio_utils.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@ MODULE pio_utils
USE mpi
USE nrtype
USE pio
USE public_var, only : iulog

implicit none

Expand Down Expand Up @@ -486,11 +485,8 @@ SUBROUTINE def_var(pioFileDesc, & ! input: file descriptor
integer(i4b), intent(out) :: ierr
character(*), intent(out) :: message ! error message
! local variables
integer(i4b) :: dimid0(1) ! dimid for no dimension
type(var_desc_t) :: pioVarId

dimid0 = 0

if (present(pioDimId)) then
ierr = pio_def_var(pioFileDesc, trim(vname), ivtype, pioDimId, pioVarId)
else
Expand Down
8 changes: 4 additions & 4 deletions route/build/src/popMetadat.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,10 +40,10 @@ module popMetadat_module
USE globalData, ONLY: meta_solute ! tracer state variables

! indices of named variables
USE var_lookup, ONLY: ixStruct , nStructures
USE var_lookup, ONLY: ixDims , nDimensions
USE var_lookup, ONLY: ixStateDims, nStateDims
USE var_lookup, ONLY: ixQdims , nQdims
USE var_lookup, ONLY: ixStruct
USE var_lookup, ONLY: ixDims
USE var_lookup, ONLY: ixStateDims
USE var_lookup, ONLY: ixQdims
USE var_lookup, ONLY: ixHRU , nVarsHRU
USE var_lookup, ONLY: ixHRU2SEG , nVarsHRU2SEG
USE var_lookup, ONLY: ixSEG , nVarsSEG
Expand Down
3 changes: 0 additions & 3 deletions route/build/src/process_param.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,9 +1,6 @@
MODULE process_param

USE nrtype
! global parameters
USE public_var, ONLY: realMissing ! missing value for real number
USE public_var, ONLY: integerMissing ! missing value for integer number

implicit none

Expand Down
7 changes: 2 additions & 5 deletions route/build/src/write_restart_pio.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ MODULE write_restart_pio

USE var_lookup, ONLY: ixRFLX, nVarsRFLX
USE var_lookup, ONLY: ixHFLX, nVarsHFLX
USE var_lookup, ONLY: ixStateDims, nStateDims
USE var_lookup, ONLY: ixStateDims
USE var_lookup, ONLY: ixIRFbas, nVarsIRFbas
USE var_lookup, ONLY: ixIRF, nVarsIRF
USE var_lookup, ONLY: ixKWT, nVarsKWT
Expand All @@ -28,7 +28,6 @@ MODULE write_restart_pio
USE public_var, ONLY: tracer ! tracer logical
! variable meta data - see popMeta.f90
USE globalData, ONLY: meta_stateDims ! states output dimensions
USE globalData, ONLY: meta_qDims ! history output dimensions
USE globalData, ONLY: meta_irf_bas ! h2o catchment routing variables
USE globalData, ONLY: meta_bas_solute ! solute catchment (hru) routing variables
USE globalData, ONLY: meta_basinQ ! catchment runoff variables
Expand All @@ -41,9 +40,8 @@ MODULE write_restart_pio
USE globalData, ONLY: meta_rflx ! reach history output variables
USE globalData, ONLY: meta_hflx ! hru history output variables
! pio stuff
USE globalData, ONLY: pid, nNodes
USE globalData, ONLY: pid
USE globalData, ONLY: masterproc
USE globalData, ONLY: mpicom_route
USE globalData, ONLY: pioSystem
USE public_var, ONLY: pio_netcdf_format
USE public_var, ONLY: pio_typename
Expand Down Expand Up @@ -210,7 +208,6 @@ SUBROUTINE restart_fname(fname, timeStamp, ierr, message)

USE public_var, ONLY: restart_dir
USE public_var, ONLY: case_name ! simulation name ==> output filename head
USE public_var, ONLY: secprday
USE globalData, ONLY: simDatetime ! current model datetime

implicit none
Expand Down