This commit backs out of defining and using profile_counts due to pre…

…vious changes in combine_radobs. Some minor changes remain, lile in read_cris, where now nrec = 999999 to make it consistent with other read routines. The changes associated in fixing the read_iasi failure in debug mode remain.

src/gsi/combine_radobs.f90

@@ -1,5 +1,5 @@
 subroutine combine_radobs(mype_sub,mype_root,&
-     npe_sub,mpi_comm_sub,nele,itxmax,nread,number_profiles,ndata,&
+     npe_sub,mpi_comm_sub,nele,itxmax,nread,ndata,&
      data_all,data_crit,nrec)
 !$$$  subprogram documentation block
 !                .      .    .                                       .
@@ -24,13 +24,11 @@ subroutine combine_radobs(mype_sub,mype_root,&
 !     itxmax   - maximum number of observations
 !     data_all - observation data array
 !     data_crit- array containing observation "best scores"
-!     number_profiles - task specific number of radiance profiless passing quality control
 !     nread    - task specific number of obesrvations read from data file
-!     ndata    - task specific number of observations keep for assimilation
 !
 !   output argument list:
 !     nread    - total number of observations read from data file (mype_root)
-!     ndata    - total number of observations keep for assimilation (mype_root)
+!     ndata    - total number of observation profiles kept for assimilation in the thinning box (mype_root)
 !     data_all - merged observation data array (mype_root)
 !     data_crit- merged array containing observation "best scores" (mype_root)
 !     
@@ -51,8 +49,8 @@ subroutine combine_radobs(mype_sub,mype_root,&
   integer(i_kind)                    ,intent(in   ) :: npe_sub,itxmax
   integer(i_kind)                    ,intent(in   ) :: nele
   integer(i_kind)                    ,intent(in   ) :: mpi_comm_sub
-  integer(i_kind)                    ,intent(in   ) :: number_profiles
-  integer(i_kind)                    ,intent(inout) :: nread,ndata
+  integer(i_kind)                    ,intent(inout) :: nread
+  integer(i_kind)                    ,intent(  out) :: ndata
   integer(i_kind),dimension(itxmax)  ,intent(in   ) :: nrec
   real(r_kind),dimension(itxmax)     ,intent(inout) :: data_crit
   real(r_kind),dimension(nele,itxmax),intent(inout) :: data_all

src/gsi/read_abi.f90

@@ -92,7 +92,7 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,&
   integer(i_kind) nmind,lnbufr,idate,ilat,ilon,nhdr,nchn,ncld,nbrst,jj
   integer(i_kind) ireadmg,ireadsb,iret,nreal,nele,itt
   integer(i_kind) itx,i,k,isflg,kidsat,n,iscan,idomsfc
-  integer(i_kind) idate5(5),maxinfo, number_profiles
+  integer(i_kind) idate5(5),maxinfo
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dg2ew,sstime,tdiff,t4dv,sfcr
@@ -501,14 +501,11 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,&
      enddo read_loop
   enddo read_msg
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call closbf(lnbufr)
   close(lnbufr)
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! Allow single task to check for bad obs, update superobs sum,
 ! and write out data to scratch file for further processing.

src/gsi/read_aerosol.f90

@@ -152,7 +152,7 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
       'SAID CLATH CLONH YEAR MNTH DAYS HOUR MINU SOZA SOLAZI RSST AOTQ RETRQ'
 
   integer(i_kind), parameter :: mxib  = 20,imax=6
-  integer(i_kind) :: nib, number_profiles
+  integer(i_kind) :: nib
   integer(i_kind) :: ibit(mxib)
 
   integer(i_kind) :: itx, itt, irec
@@ -351,11 +351,8 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
 
            end do read_modis
 
-!  number of profiles kept after thinning and QC
-           number_profiles = count(nrec(:) /= 999999,dim=1)
-
            call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-              naerodat,itxmax,nread,number_profiles,ndata,aeroout,score_crit,nrec)
+              naerodat,itxmax,nread,ndata,aeroout,score_crit,nrec)
 
            if ( mype_sub == mype_root ) then
               do n = 1, ndata
@@ -582,10 +579,8 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
               nrec(itx)=irec
            end do read_viirs
 
-           number_profiles = count(nrec(:) /= 999999,dim=1)
-
            call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-              naerodat,itxmax,nread,number_profiles,ndata,aeroout,score_crit,nrec)
+              naerodat,itxmax,nread,ndata,aeroout,score_crit,nrec)
 
            if ( mype_sub == mype_root ) then
               do n = 1, ndata

src/gsi/read_ahi.f90

@@ -98,7 +98,7 @@ subroutine read_ahi(mype,val_img,ithin,rmesh,jsatid,gstime,&
   integer(i_kind) nmind,lnbufr,idate,ilat,ilon
   integer(i_kind) ireadmg,ireadsb,iret,nreal,nele,itt
   integer(i_kind) itx,i,k,isflg,kidsat,n,iscan,idomsfc
-  integer(i_kind) idate5(5),number_profiles
+  integer(i_kind) idate5(5)
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dg2ew,sstime,tdiff,t4dv,sfcr
@@ -511,15 +511,11 @@ subroutine read_ahi(mype,val_img,ithin,rmesh,jsatid,gstime,&
 
      enddo read_loop
   enddo read_msg
-
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call closbf(lnbufr)
   close(lnbufr)
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! If no observations read, jump to end of routine.
   if (mype_sub==mype_root.and.ndata>0) then

src/gsi/read_airs.f90

@@ -160,7 +160,7 @@ subroutine read_airs(mype,val_airs,ithin,isfcalc,rmesh,jsatid,gstime,&
   character(len=512)  :: table_file
   integer(i_kind)     :: lnbufr = 10
   integer(i_kind)     :: lnbufrtab = 11
-  integer(i_kind)     :: irec,next, number_profiles
+  integer(i_kind)     :: irec,next
 
 ! Variables for BUFR IO    
   real(r_double) :: crchn_reps
@@ -860,10 +860,6 @@ subroutine read_airs(mype,val_airs,ithin,isfcalc,rmesh,jsatid,gstime,&
      enddo read_loop
 
   enddo read_subset
-
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   deallocate(allchan, chan_map, bufr_chan_test)
   call closbf(lnbufr)  ! Close bufr file
   close(lnbufr)
@@ -872,7 +868,7 @@ subroutine read_airs(mype,val_airs,ithin,isfcalc,rmesh,jsatid,gstime,&
 ! information it retained and then let single task merge files together
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! Allow single task to check for bad obs, update superobs sum,
 ! and write out data to scratch file for further processing.

src/gsi/read_amsr2.f90

@@ -128,7 +128,7 @@ subroutine read_amsr2(mype,val_amsr2,ithin,rmesh,jsatid,gstime,&
   real(r_kind)     :: dist1   
   real(r_kind),allocatable,dimension(:,:):: data_all
   integer(i_kind),allocatable,dimension(:)::nrec
-  integer(i_kind):: irec,next, number_profiles
+  integer(i_kind):: irec,next
   integer(i_kind):: method,iobs,num_obs   
   integer(i_kind),parameter  :: maxobs=2e7
 
@@ -659,14 +659,11 @@ subroutine read_amsr2(mype,val_amsr2,ithin,rmesh,jsatid,gstime,&
 
      enddo obsloop
 
-!  number of profiles kept after thinning and QC
-     number_profiles = count(nrec(:) /= 999999,dim=1)
-
 ! If multiple tasks read input bufr file, allow each tasks to write out
 ! information it retained and then let single task merge files together
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! Allow single task to check for bad obs, update superobs sum,
 ! and write out data to scratch file for further processing.

src/gsi/read_amsre.f90

@@ -169,7 +169,7 @@ subroutine read_amsre(mype,val_amsre,ithin,isfcalc,rmesh,jsatid,gstime,&
   real(r_kind)     :: pred, crit1, dist1
   real(r_kind),allocatable,dimension(:,:):: data_all
   integer(i_kind),allocatable,dimension(:)::nrec
-  integer(i_kind):: irec,next,number_profiles
+  integer(i_kind):: irec,next
   real(r_kind),dimension(0:3):: sfcpct
   real(r_kind),dimension(0:4):: rlndsea
   real(r_kind),dimension(0:3):: ts
@@ -644,18 +644,14 @@ subroutine read_amsre(mype,val_amsre,ithin,isfcalc,rmesh,jsatid,gstime,&
 
      enddo read_loop
   enddo read_msg
-
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call closbf(lnbufr)
   close(lnbufr)
 
 ! If multiple tasks read input bufr file, allow each tasks to write out
 ! information it retained and then let single task merge files together
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 
 ! Allow single task to check for bad obs, update superobs sum,

src/gsi/read_atms.f90

@@ -134,7 +134,7 @@ subroutine read_atms(mype,val_tovs,ithin,isfcalc,&
   character(80) hdr1b,hdr2b
 
   integer(i_kind) ireadsb,ireadmg,nrec_startx
-  integer(i_kind) i,j,k,ntest,iob,llll, number_profiles
+  integer(i_kind) i,j,k,ntest,iob,llll
   integer(i_kind) iret,idate,nchanl,n,idomsfc(1)
   integer(i_kind) ich1,ich2,ich8,ich15,ich16,ich17
   integer(i_kind) kidsat,maxinfo
@@ -792,11 +792,8 @@ subroutine read_atms(mype,val_tovs,ithin,isfcalc,&
   DEALLOCATE(solazi_save) 
   DEALLOCATE(bt_save)
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-       nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+       nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! 
   if(mype_sub==mype_root)then

src/gsi/read_avhrr.f90

@@ -166,7 +166,7 @@ subroutine read_avhrr(mype,val_avhrr,ithin,rmesh,jsatid,&
 
   real(r_double), dimension(13) :: hdr
   real(r_double), dimension(3,5) :: bufrf
-  integer(i_kind) :: lnbufr,ireadsb,ireadmg,iskip,irec,next,number_profiles
+  integer(i_kind) :: lnbufr,ireadsb,ireadmg,iskip,irec,next
   integer(i_kind), allocatable, dimension(:) :: nrec
   real(r_kind), allocatable, dimension(:) :: amesh
   real(r_kind), allocatable, dimension(:) :: hsst_thd
@@ -562,14 +562,10 @@ subroutine read_avhrr(mype,val_avhrr,ithin,rmesh,jsatid,&
 
         enddo read_loop
      enddo read_msg
-
      call closbf(lnbufr)
 
-!  number of profiles kept after thinning and QC
-     number_profiles = count(nrec(:) /= 999999,dim=1)
-
      call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-          nele,itxmax,nread,number_profiles,ndata_mesh,data_mesh,score_crit,nrec)
+          nele,itxmax,nread,ndata_mesh,data_mesh,score_crit,nrec)
 
      if ( nread > 0 ) then
         write(*,'(a,a10,I3,F6.1,3I10)') 'read_avhrr,satid,imesh,amesh,itxmax,nread,ndata_mesh : ',jsatid,imesh,amesh(imesh),itxmax,nread,ndata_mesh

src/gsi/read_avhrr_navy.f90

@@ -135,7 +135,7 @@ subroutine read_avhrr_navy(mype,val_avhrr,ithin,rmesh,jsatid,&
   integer(i_kind) itx,k,i,bufsat
   integer(i_kind) ireadsb,ireadmg
   integer(i_kind) nreal,nele,itt
-  integer(i_kind) nlat_sst,nlon_sst,irec,next, number_profiles
+  integer(i_kind) nlat_sst,nlon_sst,irec,next
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dlon,dlat,sfcr
@@ -464,11 +464,8 @@ subroutine read_avhrr_navy(mype,val_avhrr,ithin,rmesh,jsatid,&
 ! Normal exit
 700 continue
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 
 ! Now that we've identified the "best" observations, pull out best obs

src/gsi/read_bufrtovs.f90

@@ -192,7 +192,7 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,&
   character(len=8) :: subset
   character(len=80):: hdr1b,hdr2b
 
-  integer(i_kind) ireadsb,ireadmg,irec,next,nrec_startx, number_profiles
+  integer(i_kind) ireadsb,ireadmg,irec,next,nrec_startx
   integer(i_kind) i,j,k,ifov,ntest,llll
   integer(i_kind) sacv
   integer(i_kind) iret,idate,nchanl,n,idomsfc(1)
@@ -1061,11 +1061,8 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,&
   end do ears_db_loop
   deallocate(data1b8,data1b4)
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! 
   if(mype_sub==mype_root)then

src/gsi/read_cris.f90

@@ -187,7 +187,7 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
   integer(i_kind):: ntest
   integer(i_kind):: error_status, irecx,ierr
   integer(i_kind):: radedge_min, radedge_max
-  integer(i_kind):: bufr_size, number_profiles
+  integer(i_kind):: bufr_size
   character(len=20),allocatable,dimension(:) :: sensorlist
 
 ! Imager cluster information for CADS
@@ -1013,14 +1013,11 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
   if (error_status /= success) &
      write(6,*)'OBSERVER:  ***ERROR*** crtm_spccoeff_destroy error_status=',error_status
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
 ! If multiple tasks read input bufr file, allow each tasks to write out
 ! information it retained and then let single task merge files together
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! Allow single task to check for bad obs, update superobs sum,
 ! and write out data to scratch file for further processing.

src/gsi/read_gmi.f90

@@ -165,7 +165,7 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,&
   logical        :: assim,outside,iuse
   logical        :: do_noise_reduction
 
-  integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,number_profiles,next,j
+  integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,next,j
   integer(i_kind):: iret,idate,nchanl,nchanla
   integer(i_kind):: isflg,nreal,idomsfc
   integer(i_kind):: nmind,itx,nele,itt
@@ -782,14 +782,10 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,&
     nrec(itx)=irec
   end do obsloop
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
 ! If multiple tasks read input bufr file, allow each tasks to write out
 ! information it retained and then let single task merge files together
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
-
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
   if( mype_sub==mype_root) write(6,*) 'READ_GMI: after combine_obs, nread,ndata is ',nread,ndata
 
 !=========================================================================================================

src/gsi/read_goesimg.f90

@@ -116,7 +116,7 @@ subroutine read_goesimg(mype,val_img,ithin,rmesh,jsatid,gstime,&
 
   character(8) subset
 
-  integer(i_kind) nchanl,ilath,ilonh,ilzah,iszah,irec,next, number_profiles
+  integer(i_kind) nchanl,ilath,ilonh,ilzah,iszah,irec,next
   integer(i_kind) nmind,lnbufr,idate,ilat,ilon,maxinfo
   integer(i_kind) ireadmg,ireadsb,iret,nreal,nele,itt
   integer(i_kind) itx,i,k,isflg,kidsat,n,iscan,idomsfc
@@ -410,11 +410,8 @@ subroutine read_goesimg(mype,val_img,ithin,rmesh,jsatid,gstime,&
      enddo read_loop
   enddo read_msg
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
-
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 ! If no observations read, jump to end of routine.
   if (mype_sub==mype_root.and.ndata>0) then

src/gsi/read_goesndr.f90

@@ -147,7 +147,7 @@ subroutine read_goesndr(mype,val_goes,ithin,rmesh,jsatid,infile,&
   integer(i_kind) itx,k,i,itt,iskip,l,ifov,n
   integer(i_kind) ichan8,ich8
   integer(i_kind) nele,iscan,nmind
-  integer(i_kind) ntest,ireadsb,ireadmg,irec,next, number_profiles
+  integer(i_kind) ntest,ireadsb,ireadmg,irec,next
   integer(i_kind),dimension(5):: idate5
   integer(i_kind),allocatable,dimension(:)::nrec
   integer(i_kind) ibfms         ! BUFR missing value function
@@ -515,14 +515,12 @@ subroutine read_goesndr(mype,val_goes,ithin,rmesh,jsatid,infile,&
   call closbf(lnbufr)
   close(lnbufr)
 
-!  number of profiles kept after thinning and QC
-  number_profiles = count(nrec(:) /= 999999,dim=1)
 
 ! If multiple tasks read input bufr file, allow each tasks to write out
 ! information it retained and then let single task merge files together
 
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
 
 
 ! Allow single task to check for bad obs, update superobs sum,