Merge pull request #7 from DavidHuber-NOAA/intel2022_dh

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

src/gsi/ensctl2state.f90

@@ -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)
@@ -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 )
@@ -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

src/gsi/ensctl2state_ad.f90

@@ -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)
@@ -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

src/gsi/genstats_gps.f90

@@ -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

src/gsi/read_iasi.f90

@@ -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
 

src/gsi/read_prepbufr.f90

@@ -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
@@ -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 
@@ -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)
@@ -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

src/gsi/setupaod.f90

@@ -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

src/gsi/setupdbz.f90

@@ -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'

src/gsi/setupdw.f90

@@ -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'

src/gsi/setuplight.f90

@@ -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

src/gsi/setuplwcp.f90

@@ -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'

src/gsi/setupoz.f90

@@ -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:
@@ -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'

src/gsi/setupps.f90

@@ -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'

src/gsi/setuppw.f90

@@ -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

src/gsi/setupq.f90

@@ -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'
@@ -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'

src/gsi/setuprad.f90

@@ -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
 

src/gsi/setuprw.f90

@@ -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'

src/gsi/setupspd.f90

@@ -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'

src/gsi/setupsst.f90

@@ -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'

src/gsi/setupswcp.f90

@@ -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'

src/gsi/setupt.f90

@@ -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'
@@ -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'

src/gsi/setuptcp.f90

@@ -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

src/gsi/setupw.f90

@@ -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'