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

Fix array out-of-bounds error, switch to nint, follow standard for use statements, match end if #7

Merged
merged 2 commits into from
May 19, 2023
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
9 changes: 7 additions & 2 deletions src/gsi/ensctl2state.f90
Original file line number Diff line number Diff line change
Expand Up @@ -240,7 +240,6 @@ subroutine ensctl2state(xhat,mval,eval)
!$omp section

! Get pointers to required state variables
call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus)
call gsi_bundlegetpointer (eval(jj),'sst' ,sv_sst, istatus)
if(ls_w)then
call gsi_bundlegetpointer (eval(jj),'w' ,sv_w, istatus)
Expand All @@ -249,7 +248,6 @@ subroutine ensctl2state(xhat,mval,eval)
end if
end if
! Copy variables
call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus )
call gsi_bundlegetvar ( wbundle_c, 'sst', sv_sst, istatus )
if(lc_w)then
call gsi_bundlegetvar ( wbundle_c, 'w' , sv_w, istatus )
Expand All @@ -258,6 +256,13 @@ subroutine ensctl2state(xhat,mval,eval)
end if
end if

! Get the ozone vector if it is defined
id=getindex(cvars3d,"oz")
if(id > 0) then
call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus)
call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus )
endif

!$omp end parallel sections

! Add contribution from static B, if necessary
Expand Down
9 changes: 7 additions & 2 deletions src/gsi/ensctl2state_ad.f90
Original file line number Diff line number Diff line change
Expand Up @@ -206,9 +206,7 @@ subroutine ensctl2state_ad(eval,mval,grad)

!$omp section

call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus)
call gsi_bundlegetpointer (eval(jj),'sst' ,rv_sst, istatus)
call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus )
call gsi_bundleputvar ( wbundle_c, 'sst', rv_sst, istatus )
if(wdw_exist)then
call gsi_bundlegetpointer (eval(jj),'w' ,rv_w, istatus)
Expand All @@ -219,6 +217,13 @@ subroutine ensctl2state_ad(eval,mval,grad)
end if
end if

! Get the ozone vector if it is defined
id=getindex(cvars3d,"oz")
if(id > 0) then
call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus)
call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus )
endif

!$omp section

if (do_cw_to_hydro_ad .and. .not.do_cw_to_hydro_ad_hwrf) then
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/genstats_gps.f90
Original file line number Diff line number Diff line change
Expand Up @@ -754,7 +754,7 @@ end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_
use sparsearr, only: sparr2, readarray, fullarray
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
integer(i_kind),dimension(miter) :: obsdiag_iuse
integer(i_kind) :: obstype, obssubtype
type(sparr2) :: dhx_dx
Expand Down
2 changes: 0 additions & 2 deletions src/gsi/read_iasi.f90
Original file line number Diff line number Diff line change
Expand Up @@ -729,8 +729,6 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,&
else
temperature(bufr_chan) = tbmin
endif
else
temperature(bufr_chan) = tbmin
end if
end do channel_loop

Expand Down
73 changes: 29 additions & 44 deletions src/gsi/read_prepbufr.f90
Original file line number Diff line number Diff line change
Expand Up @@ -689,26 +689,20 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&

! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999
! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299
! Prevent integer overflow by nint
if(hdr(3) < huge_i_kind) then
if (id_drifter .and. (kx==180 .or. kx==280) .and. idnint(hdr(3))==562) then
rstation_id=hdr(4)
read(c_station_id,*,iostat=ios) iwmo
if (ios == 0 .and. iwmo > 0) then
if(mod(iwmo,1000) >=500) then
kx = kx + 19
end if
if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(3),r_double)==562) then
rstation_id=hdr(4)
read(c_station_id,*,iostat=ios) iwmo
if (ios == 0 .and. iwmo > 0) then
if(mod(iwmo,1000) >=500) then
kx = kx + 19
end if
end if
end if

!Prevent integer overflow by nint
if(hdr(3) < huge_i_kind) then
if (id_ship .and. (kx==180) .and. (idnint(hdr(3))==522 .or. idnint(hdr(3))==523)) then
rstation_id=hdr(4)
kx = kx + 18
end if
endif
if (id_ship .and. (kx==180) .and. (nint(hdr(3),r_double)==522 .or. nint(hdr(3),r_double)==523)) then
rstation_id=hdr(4)
kx = kx + 18
end if

if(twodvar_regional)then
! If running in 2d-var (surface analysis) mode, check to see if observation
Expand Down Expand Up @@ -974,26 +968,20 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
!
! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999
! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299
!Prevent integer overflow by nint
if(hdr(8) < huge_i_kind) then
if (id_drifter .and. (kx==180 .or. kx==280) .and. idnint(hdr(8))==562 ) then
rstation_id=hdr(1)
read(c_station_id,*,iostat=ios) iwmo
if (ios == 0 .and. iwmo > 0) then
if(mod(iwmo,1000) >=500) then
kx = kx + 19
end if
if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(8),r_double)==562) then
rstation_id=hdr(1)
read(c_station_id,*,iostat=ios) iwmo
if (ios == 0 .and. iwmo > 0) then
if(mod(iwmo,1000) >=500) then
kx = kx + 19
end if
end if
endif
end if

!Prevent integer overflow by nint
if(hdr(8) < huge_i_kind) then
if (id_ship .and. (kx==180) .and. (idnint(hdr(8))==522 .or. idnint(hdr(8))==523) ) then
rstation_id=hdr(1)
kx = kx + 18
end if
endif
if (id_ship .and. (kx==180) .and. (nint(hdr(8),r_double)==522 .or. nint(hdr(8),r_double)==523) ) then
rstation_id=hdr(1)
kx = kx + 18
end if
!

! check VAD subtype. 1--old, 2--new, other--old
Expand Down Expand Up @@ -1650,8 +1638,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
qcmark(3,k)=min(tobaux(2,k,j),qcmark_huge)
tqm(k)=idnint(qcmark(3,k))
exit
endif
endif
end if
end if
if (tpc(k,j)==vtcd) then
obsdat(3,k)=tobaux(1,k,j+1)
qcmark(3,k)=min(tobaux(2,k,j+1),qcmark_huge)
Expand Down Expand Up @@ -2143,23 +2131,20 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
oelev=windsensht+selev !windsensht: read in from prepbufr
else
oelev=r10+selev
endif
end if
if (kx == 280 )then
!Prevent integer overflow by nint
if(hdr(8) < huge_i_kind) then
it29=idnint(hdr(8))
if(it29 == 522 .or. it29 == 523 .or. it29 == 531)then
it29=nint(hdr(8),r_double)
if(it29 == 522 .or. it29 == 523 .or. it29 == 531)then
! oelev=r20+selev
oelev=r20
end if
oelev=r20
end if
endif
end if

if (kx == 282) oelev=r20+selev
if (kx == 285 .or. kx == 289 .or. kx == 290) then
oelev=selev
selev=zero
endif
end if
else
if((kx >= 221 .and. kx <= 229) &
.and. selev >= oelev) oelev=r10+selev
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupaod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -827,7 +827,7 @@ subroutine contents_netcdf_diag_
! subroutine to write contents to netcdf diag files
! original: pagowski
! modified: 2019-03-21 - martin - cleaned up to fit GSI coding norms
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
implicit none
character(7),parameter :: obsclass = ' aod'
character(128) :: fieldname
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupdbz.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1921,7 +1921,7 @@ subroutine contents_binary_dirZDA_diag_(odiag)
end subroutine contents_binary_dirZDA_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' dbz'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupdw.f90
Original file line number Diff line number Diff line change
Expand Up @@ -896,7 +896,7 @@ subroutine contents_binary_diag_(odiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' dw'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuplight.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1615,7 +1615,7 @@ end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
! Observation class
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
character(7),parameter :: obsclass = ' light'
real(r_single),parameter:: missing = -9.99e9_r_single
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuplwcp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -838,7 +838,7 @@ end subroutine contents_binary_diag_

subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' lwcp'
Expand Down
4 changes: 2 additions & 2 deletions src/gsi/setupoz.f90
Original file line number Diff line number Diff line change
Expand Up @@ -152,7 +152,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,&
use m_dtime, only: dtime_setup, dtime_check
use gsi_bundlemod, only : gsi_bundlegetpointer
use gsi_metguess_mod, only : gsi_metguess_get,gsi_metguess_bundle
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
implicit none

! !INPUT PARAMETERS:
Expand Down Expand Up @@ -1662,7 +1662,7 @@ subroutine contents_binary_diag_(odiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' ozlev'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupps.f90
Original file line number Diff line number Diff line change
Expand Up @@ -882,7 +882,7 @@ subroutine contents_binary_diag_(odiag)

end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' ps'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuppw.f90
Original file line number Diff line number Diff line change
Expand Up @@ -711,7 +711,7 @@ subroutine contents_binary_diag_(odiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
! use model surface pressure, so PW can be used in EnKF analysis
Expand Down
4 changes: 2 additions & 2 deletions src/gsi/setupq.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1262,7 +1262,7 @@ end subroutine contents_binary_diagp_

subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' q'
Expand Down Expand Up @@ -1336,7 +1336,7 @@ end subroutine contents_netcdf_diag_

subroutine contents_netcdf_diagp_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' q'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuprad.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2543,7 +2543,7 @@ subroutine contents_binary_diag_(odiags,idv,iob)

end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiags,idv,iob)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(fptr_obsdiagNode),dimension(:),intent(in):: odiags
integer(i_kind),intent(in):: idv,iob

Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuprw.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1312,7 +1312,7 @@ subroutine contents_binary_diag_(odiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' rw'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupspd.f90
Original file line number Diff line number Diff line change
Expand Up @@ -942,7 +942,7 @@ subroutine contents_binary_diag_(odiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' spd'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupsst.f90
Original file line number Diff line number Diff line change
Expand Up @@ -576,7 +576,7 @@ subroutine contents_binary_diag_(odiag)
endif
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' sst'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupswcp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -883,7 +883,7 @@ end subroutine contents_binary_diag_

subroutine contents_netcdf_diag_(odiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' swcp'
Expand Down
4 changes: 2 additions & 2 deletions src/gsi/setupt.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1663,7 +1663,7 @@ subroutine contents_binary_diagp_(odiag)
end subroutine contents_binary_diagp_

subroutine contents_netcdf_diag_(odiag)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' t'
Expand Down Expand Up @@ -1760,7 +1760,7 @@ subroutine contents_netcdf_diag_(odiag)
end subroutine contents_netcdf_diag_

subroutine contents_netcdf_diagp_(odiag)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: odiag
! Observation class
character(7),parameter :: obsclass = ' t'
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setuptcp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -684,7 +684,7 @@ subroutine contents_binary_diag_(odiag)

end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(odiag)
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
use constants, only: r_missing
type(obs_diag),pointer,intent(in):: odiag
! Observation class
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/setupw.f90
Original file line number Diff line number Diff line change
Expand Up @@ -1780,7 +1780,7 @@ subroutine contents_binary_diag_(udiag,vdiag)
end subroutine contents_binary_diag_
subroutine contents_netcdf_diag_(udiag,vdiag)
use constants, only: r_missing
use screen_to_ncdiag
use screen_to_ncdiag, only: screen_to_single_nc_diag_metadata
type(obs_diag),pointer,intent(in):: udiag,vdiag
! Observation class
character(7),parameter :: obsclass = ' uv'
Expand Down
Loading