Fixed "NAN" issue for brightness temperatures in read_iasi.f90 These …

…were caused by the radiance scaling factor being missing in the DBNet data. Corrected sending in profile counts into combine_radobs instead of total channel counts in most satellite data read routines. Not all of them were tested. Several no longer exist.

src/gsi/combine_radobs.f90

@@ -74,7 +74,7 @@ subroutine combine_radobs(mype_sub,mype_root,&
 
      nread=0
      if (mype_sub==mype_root) nread = ncounts1
-     if (ncounts1 == 0)return
+     if (ncounts1 <= 0)return
 
 !    Allocate arrays to hold data
 

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
+  integer(i_kind) idate5(5),maxinfo, number_profiles
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dg2ew,sstime,tdiff,t4dv,sfcr
@@ -501,11 +501,13 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,&
      enddo read_loop
   enddo read_msg
 
+  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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind) :: nib, number_profiles
   integer(i_kind) :: ibit(mxib)
 
   integer(i_kind) :: itx, itt, irec
@@ -351,8 +351,10 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
 
            end do read_modis
 
+           number_profiles = count(nrec(:) /= 999999,dim=1)
+
            call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-              naerodat,itxmax,nread,ndata,aeroout,score_crit,nrec)
+              naerodat,itxmax,number_profiles,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)
+  integer(i_kind) idate5(5),number_profiles
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dg2ew,sstime,tdiff,t4dv,sfcr
@@ -511,11 +511,14 @@ subroutine read_ahi(mype,val_img,ithin,rmesh,jsatid,gstime,&
 
      enddo read_loop
   enddo read_msg
+
+  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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind)     :: irec,next, number_profiles
 
 ! Variables for BUFR IO    
   real(r_double) :: crchn_reps
@@ -860,6 +860,9 @@ subroutine read_airs(mype,val_airs,ithin,isfcalc,rmesh,jsatid,gstime,&
      enddo read_loop
 
   enddo read_subset
+
+  number_profiles = count(nrec(:) /= 999999,dim=1)
+
   deallocate(allchan, chan_map, bufr_chan_test)
   call closbf(lnbufr)  ! Close bufr file
   close(lnbufr)
@@ -868,7 +871,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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,nread,number_profiles,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
+  integer(i_kind):: irec,next, number_profiles
   integer(i_kind):: method,iobs,num_obs   
   integer(i_kind),parameter  :: maxobs=2e7
 
@@ -659,11 +659,13 @@ subroutine read_amsr2(mype,val_amsr2,ithin,rmesh,jsatid,gstime,&
 
      enddo obsloop
 
+     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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind):: irec,next,number_profiles
   real(r_kind),dimension(0:3):: sfcpct
   real(r_kind),dimension(0:4):: rlndsea
   real(r_kind),dimension(0:3):: ts
@@ -644,14 +644,17 @@ subroutine read_amsre(mype,val_amsre,ithin,isfcalc,rmesh,jsatid,gstime,&
 
      enddo read_loop
   enddo read_msg
+
+  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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind) i,j,k,ntest,iob,llll, number_profiles
   integer(i_kind) iret,idate,nchanl,n,idomsfc(1)
   integer(i_kind) ich1,ich2,ich8,ich15,ich16,ich17
   integer(i_kind) kidsat,maxinfo
@@ -792,8 +792,10 @@ subroutine read_atms(mype,val_tovs,ithin,isfcalc,&
   DEALLOCATE(solazi_save) 
   DEALLOCATE(bt_save)
 
+  number_profiles = count(nrec(:) /= 999999,dim=1)
+
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-       nele,itxmax,nread,ndata,data_all,score_crit,nrec)
+       nele,itxmax,number_profiles,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
+  integer(i_kind) :: lnbufr,ireadsb,ireadmg,iskip,irec,next,number_profiles
   integer(i_kind), allocatable, dimension(:) :: nrec
   real(r_kind), allocatable, dimension(:) :: amesh
   real(r_kind), allocatable, dimension(:) :: hsst_thd
@@ -562,10 +562,13 @@ subroutine read_avhrr(mype,val_avhrr,ithin,rmesh,jsatid,&
 
         enddo read_loop
      enddo read_msg
+
+     number_profiles = count(nrec(:) /= 999999,dim=1)
+
      call closbf(lnbufr)
 
      call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-          nele,itxmax,nread,ndata_mesh,data_mesh,score_crit,nrec)
+          nele,itxmax,number_profiles,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
+  integer(i_kind) nlat_sst,nlon_sst,irec,next, number_profiles
   integer(i_kind),allocatable,dimension(:)::nrec
 
   real(r_kind) dlon,dlat,sfcr
@@ -255,6 +255,7 @@ subroutine read_avhrr_navy(mype,val_avhrr,ithin,rmesh,jsatid,&
   next=0
 
 ! Read BUFR Navy data
+  nrec = 999999
   irec=0
   read_msg: do while (ireadmg(lnbufr,subset,idate) >= 0)
      irec=irec+1
@@ -463,8 +464,10 @@ subroutine read_avhrr_navy(mype,val_avhrr,ithin,rmesh,jsatid,&
 ! Normal exit
 700 continue
 
+  number_profiles = count(nrec(:) /= 999999,dim=1)
+
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind) ireadsb,ireadmg,irec,next,nrec_startx, number_profiles
   integer(i_kind) i,j,k,ifov,ntest,llll
   integer(i_kind) sacv
   integer(i_kind) iret,idate,nchanl,n,idomsfc(1)
@@ -490,7 +490,7 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,&
   hdr2b ='SAZA SOZA BEARAZ SOLAZI'
   allocate(data_all(nele,itxmax),data1b8(nchanl),data1b4(nchanl),nrec(itxmax))
 
-
+  nrec = 999999
   next=0
   irec=0
 ! Big loop over standard data feed and possible ears/db data
@@ -1061,8 +1061,10 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,&
   end do ears_db_loop
   deallocate(data1b8,data1b4)
 
+  number_profiles = count(nrec(:) /= 999999,dim=1)
+
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind):: bufr_size, number_profiles
   character(len=20),allocatable,dimension(:) :: sensorlist
 
 ! Imager cluster information for CADS
@@ -455,7 +455,7 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
 ! Big loop to read data file
   next=0
   irec=0
-  nrec = 99999
+  nrec = 999999
 ! Big loop over standard data feed and possible rars/db data
 ! llll=1 is normal feed, llll=2 RARS data, llll=3 DB/UW data)
   ears_db_loop: do llll= 1, 3
@@ -1013,11 +1013,13 @@ 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_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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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,next,j
+  integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,number_profiles,next,j
   integer(i_kind):: iret,idate,nchanl,nchanla
   integer(i_kind):: isflg,nreal,idomsfc
   integer(i_kind):: nmind,itx,nele,itt
@@ -782,10 +782,13 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,&
     nrec(itx)=irec
   end do obsloop
 
+  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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind) nchanl,ilath,ilonh,ilzah,iszah,irec,next, number_profiles
   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,8 +410,10 @@ subroutine read_goesimg(mype,val_img,ithin,rmesh,jsatid,gstime,&
      enddo read_loop
   enddo read_msg
 
+  number_profiles = count(nrec(:) /= 999999,dim=1)
+
   call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,&
-     nele,itxmax,nread,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,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
+  integer(i_kind) ntest,ireadsb,ireadmg,irec,next, number_profiles
   integer(i_kind),dimension(5):: idate5
   integer(i_kind),allocatable,dimension(:)::nrec
   integer(i_kind) ibfms         ! BUFR missing value function
@@ -515,12 +515,13 @@ subroutine read_goesndr(mype,val_goes,ithin,rmesh,jsatid,infile,&
   call closbf(lnbufr)
   close(lnbufr)
 
+  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,ndata,data_all,score_crit,nrec)
+     nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec)
 
 
 ! Allow single task to check for bad obs, update superobs sum,