From a746a3128b376baee3c489c4cb9dbb5461231435 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Fri, 30 Aug 2024 14:16:44 +0000 Subject: [PATCH 01/12] These are changes to various output files. It removes the "****" from the output. --- src/enkf/enkf_obs_sensitivity.f90 | 2 +- src/enkf/innovstats.f90 | 2 +- src/gsi/statsrad.f90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/enkf/enkf_obs_sensitivity.f90 b/src/enkf/enkf_obs_sensitivity.f90 index 72296d5934..b257e23ee3 100644 --- a/src/enkf/enkf_obs_sensitivity.f90 +++ b/src/enkf/enkf_obs_sensitivity.f90 @@ -547,7 +547,7 @@ subroutine print_ob_sens if(nob_sat(nchan) > 0) then rate_sat(nchan,1:3) = rate_sat(nchan,1:3) & & / real(nob_sat(nchan),r_kind) * 100._r_kind - write(*,'(a20,i5,i7,3(1x,e12.5),3(1x,f7.2))') & + write(*,'(a22,i6,i7,3(1x,e12.5),3(1x,f7.2))') & & trim(adjustl(nusis(nchan))), & & nuchan(nchan),nob_sat(nchan),sumsense_sat(nchan,1:3), & & rate_sat(nchan,1:3) diff --git a/src/enkf/innovstats.f90 b/src/enkf/innovstats.f90 index 853532c9b9..46b3719e8c 100644 --- a/src/enkf/innovstats.f90 +++ b/src/enkf/innovstats.f90 @@ -278,7 +278,7 @@ subroutine print_innovstats(obfit,obsprd) sqrt(sumerr_sat(nchan)) end if end do -9805 format(a20,i4,1x,i5,5(1x,e10.3)) +9805 format(a20,i6,1x,i5,5(1x,e10.3)) end if !nobs_sat>0 end subroutine print_innovstats diff --git a/src/gsi/statsrad.f90 b/src/gsi/statsrad.f90 index dfedcc92ab..986ab4e226 100644 --- a/src/gsi/statsrad.f90 +++ b/src/gsi/statsrad.f90 @@ -161,7 +161,7 @@ subroutine statsrad(aivals,stats,ndata) 2011 format(8x,f16.8,8(i7,1x)) 2012 format(12x,A7,5x,8(a7,1x)) 2999 format(' Illegal satellite type ') -1102 format(1x,i4,i6,1x,a20,2i7,1x,f10.3,1x,6(f11.7,1x)) +1102 format(1x,i6,i6,1x,a20,2i7,1x,f10.3,1x,6(f11.7,1x)) 1109 format(t5,'it',t13,'satellite',t23,'instrument',t40, & '# read',t53,'# keep',t65,'# assim',& t75,'penalty',t88,'qcpnlty',t104,'cpen',t115,'qccpen') From 1c0e6978af8ae4b4620d08efab382971e552db9f Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Fri, 30 Aug 2024 14:38:03 +0000 Subject: [PATCH 02/12] The current code is hard wired to use 3000 channels per instrument. This change allows the number of channels to be defined at run time. --- src/gsi/radinfo.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/gsi/radinfo.f90 b/src/gsi/radinfo.f90 index 8bb496c645..2abc4c7b04 100644 --- a/src/gsi/radinfo.f90 +++ b/src/gsi/radinfo.f90 @@ -805,7 +805,7 @@ subroutine radinfo_read end do close(lunin) 100 format(a1,a120) -110 format(i4,1x,a20,' chan= ',i5, & +110 format(i6,1x,a20,' chan= ',i5, & ' var= ',f7.3,' varch_cld=',f7.3,' use= ',i2,' ermax= ',F7.3, & ' b_rad= ',F7.2,' pg_rad=',F7.2,' icld_det=',I2,' icloud=',I2,' iaeros=',I2) 111 format(i4,1x,a20,' chan= ',i5, & @@ -1135,7 +1135,7 @@ subroutine radinfo_read nusis(j),nuchan(j),' not found in satbias_in file - set to zero ' endif end do -140 format(i4,1x,a20,12f12.6) +140 format(i5,1x,a20,12f12.6) endif @@ -1687,7 +1687,6 @@ subroutine init_predx integer(i_kind),parameter:: lntemp = 51 integer(i_kind),parameter:: nthreshold = 100 - integer(i_kind),parameter:: maxchn = 3000 integer(i_kind),parameter:: maxdat = 100 real(r_kind), parameter:: atiny = 1.0e-10_r_kind @@ -1712,7 +1711,7 @@ subroutine init_predx integer(i_kind):: np,new_chan,nc integer(i_kind):: counttmp, jjstart, sensor_start, sensor_end integer(i_kind):: radedge_min, radedge_max - integer(i_kind),dimension(maxchn):: ich + integer(i_kind),allocatable,dimension(:):: ich integer(i_kind),dimension(maxdat):: ipoint real(r_kind):: bias,scan,errinv,rnad @@ -1814,6 +1813,7 @@ subroutine init_predx mype, trim(fdiag_rad), header_fix%idate satsens = header_fix%isis n_chan = header_fix%nchan + allocate(ich(n_chan)) ! Check for consistency between specified and retrieved satellite id ! after first sorting out some historical naming conventions @@ -2063,7 +2063,7 @@ subroutine init_predx if ( nuchan(jj) == header_chan(j)%nuchan ) then jjstart = jj + 1 write(lntemp,220) jj,tlapmean(jj),tsum_tlapmean(jj),count_tlapmean(jj) -220 format(I5,1x,2e15.6,1x,I5) +220 format(I5,1x,2e15.6,1x,I6) cycle loop_c endif end do From 09c724532eda98a7429e815330c23be4942b78db Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Tue, 3 Sep 2024 11:50:03 +0000 Subject: [PATCH 03/12] 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 | 2 +- src/gsi/read_abi.f90 | 6 ++++-- src/gsi/read_aerosol.f90 | 6 ++++-- src/gsi/read_ahi.f90 | 7 +++++-- src/gsi/read_airs.f90 | 7 +++++-- src/gsi/read_amsr2.f90 | 6 ++++-- src/gsi/read_amsre.f90 | 7 +++++-- src/gsi/read_atms.f90 | 6 ++++-- src/gsi/read_avhrr.f90 | 7 +++++-- src/gsi/read_avhrr_navy.f90 | 7 +++++-- src/gsi/read_bufrtovs.f90 | 8 +++++--- src/gsi/read_cris.f90 | 8 +++++--- src/gsi/read_gmi.f90 | 7 +++++-- src/gsi/read_goesimg.f90 | 6 ++++-- src/gsi/read_goesndr.f90 | 5 +++-- src/gsi/read_iasi.f90 | 20 +++++++++++--------- src/gsi/read_saphir.f90 | 7 ++++--- src/gsi/read_ssmi.f90 | 6 ++++-- src/gsi/read_ssmis.f90 | 6 ++++-- src/gsi/read_viirs.f90 | 6 +++--- 20 files changed, 90 insertions(+), 50 deletions(-) diff --git a/src/gsi/combine_radobs.f90 b/src/gsi/combine_radobs.f90 index 7692bdef3b..5c32188748 100644 --- a/src/gsi/combine_radobs.f90 +++ b/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 diff --git a/src/gsi/read_abi.f90 b/src/gsi/read_abi.f90 index eaa6b1675f..40f8f8e3be 100644 --- a/src/gsi/read_abi.f90 +++ b/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. diff --git a/src/gsi/read_aerosol.f90 b/src/gsi/read_aerosol.f90 index a58b2d4358..09a0419846 100644 --- a/src/gsi/read_aerosol.f90 +++ b/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 diff --git a/src/gsi/read_ahi.f90 b/src/gsi/read_ahi.f90 index 5191bbee19..b54a835d7b 100644 --- a/src/gsi/read_ahi.f90 +++ b/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 diff --git a/src/gsi/read_airs.f90 b/src/gsi/read_airs.f90 index c5392dad14..9647d4af8e 100644 --- a/src/gsi/read_airs.f90 +++ b/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. diff --git a/src/gsi/read_amsr2.f90 b/src/gsi/read_amsr2.f90 index 9d8d4944d9..cfbf60089e 100644 --- a/src/gsi/read_amsr2.f90 +++ b/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. diff --git a/src/gsi/read_amsre.f90 b/src/gsi/read_amsre.f90 index ef0c2ad2bb..d36e34a4e2 100755 --- a/src/gsi/read_amsre.f90 +++ b/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,6 +644,9 @@ 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) @@ -651,7 +654,7 @@ subroutine read_amsre(mype,val_amsre,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,number_profiles,ndata,data_all,score_crit,nrec) ! Allow single task to check for bad obs, update superobs sum, diff --git a/src/gsi/read_atms.f90 b/src/gsi/read_atms.f90 index 424843a7c1..47884b7909 100644 --- a/src/gsi/read_atms.f90 +++ b/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 diff --git a/src/gsi/read_avhrr.f90 b/src/gsi/read_avhrr.f90 index c1509828ad..3e02af0d45 100755 --- a/src/gsi/read_avhrr.f90 +++ b/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 diff --git a/src/gsi/read_avhrr_navy.f90 b/src/gsi/read_avhrr_navy.f90 index dd5a64083a..817028498d 100644 --- a/src/gsi/read_avhrr_navy.f90 +++ b/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 diff --git a/src/gsi/read_bufrtovs.f90 b/src/gsi/read_bufrtovs.f90 index 2fc14b5cdf..5e0fde2c04 100644 --- a/src/gsi/read_bufrtovs.f90 +++ b/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 diff --git a/src/gsi/read_cris.f90 b/src/gsi/read_cris.f90 index 84288a7f04..38e820e7e0 100644 --- a/src/gsi/read_cris.f90 +++ b/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. diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 6ad4d829a3..27bff7000d 100644 --- a/src/gsi/read_gmi.f90 +++ b/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 !========================================================================================================= diff --git a/src/gsi/read_goesimg.f90 b/src/gsi/read_goesimg.f90 index bf40a1f163..4de04e6969 100644 --- a/src/gsi/read_goesimg.f90 +++ b/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 diff --git a/src/gsi/read_goesndr.f90 b/src/gsi/read_goesndr.f90 index 7c55b6ab4c..041437e367 100644 --- a/src/gsi/read_goesndr.f90 +++ b/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, diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 75dc50bb76..d2f9157a38 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -219,7 +219,7 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind):: error_status, irecx,ierr integer(i_kind):: radedge_min, radedge_max integer(i_kind) :: subset_start, subset_end, satinfo_nchan, sc_chan, bufr_chan - integer(i_kind) :: sfc_channel_index + integer(i_kind) :: sfc_channel_index, number_profiles integer(i_kind),allocatable, dimension(:) :: channel_number, sc_index, bufr_index integer(i_kind),allocatable, dimension(:) :: bufr_chan_test character(len=20),allocatable, dimension(:):: sensorlist @@ -711,14 +711,14 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& iexponent = -(nint(cscale(3,i)) - 5) sscale(i)=ten**iexponent else - sscale(i)=0.0_r_kind + sscale(i)= zero endif end do ! Read IASI channel number(CHNM) and radiance (SCRA) call ufbseq(lnbufr,allchan,2,bufr_nchan,iret,'IASICHN') jstart=1 - scalef=one + scalef=zero do i=1,bufr_nchan scaleloop: do j=jstart,10 if(allchan(1,i) >= cscale(1,j) .and. allchan(1,i) <= cscale(2,j))then @@ -757,17 +757,17 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& cycle read_loop endif + temperature(:) = tbmin !$omp parallel do schedule(dynamic,1) private(i,sc_chan,bufr_chan,radiance) channel_loop: do i=1,satinfo_nchan bufr_chan = bufr_index(i) if (bufr_chan > 0 ) then ! check that channel number is within reason - if (( allchan(2,bufr_chan) > zero .and. allchan(2,bufr_chan) < 99999._r_kind)) then ! radiance bounds + if (( allchan(2,bufr_chan) > zero .and. allchan(2,bufr_chan) < 99999._r_kind) & ! radiance bounds + .and. scalef(bufr_chan) > zero ) then ! radiance scale factor exists radiance = allchan(2,bufr_chan)*scalef(bufr_chan) sc_chan = sc_index(i) call crtm_planck_temperature(sensorindex_iasi,sc_chan,radiance,temperature(bufr_chan)) - else - temperature(bufr_chan) = tbmin endif end if end do channel_loop @@ -777,8 +777,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& skip_loop: do i=1,satinfo_nchan if ( bufr_index(i) == 0 ) cycle skip_loop bufr_chan = bufr_index(i) - if(temperature(bufr_chan) <= tbmin .or. temperature(bufr_chan) > tbmax ) then - temperature(bufr_chan) = min(tbmax,max(tbmin,temperature(bufr_chan))) + if(temperature(bufr_chan) <= tbmin .or. temperature(bufr_chan) >= tbmax ) then + temperature(bufr_chan) = tbmin if(iuse_rad(ioff+i) >= 0)iskip = iskip + 1 endif end do skip_loop @@ -970,6 +970,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& end do ears_db_loop + number_profiles = count(nrec(:) /= 999999,dim=1) + deallocate(temperature, allchan, bufr_chan_test,scalef) deallocate(channel_number,sc_index) deallocate(bufr_index) @@ -982,7 +984,7 @@ subroutine read_iasi(mype,val_iasi,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,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. diff --git a/src/gsi/read_saphir.f90 b/src/gsi/read_saphir.f90 index 06e992b03d..18f070b479 100644 --- a/src/gsi/read_saphir.f90 +++ b/src/gsi/read_saphir.f90 @@ -110,7 +110,7 @@ subroutine read_saphir(mype,val_tovs,ithin,isfcalc,& character(8) :: subset character(80) :: hdr1b,hdr2b - integer(i_kind) :: ireadsb,ireadmg,irec + integer(i_kind) :: ireadsb,ireadmg, number_profiles integer(i_kind) :: i,j,k,ntest,iob integer(i_kind) :: iret,idate,nchanl,n,idomsfc(1) integer(i_kind) :: kidsat,maxinfo @@ -293,7 +293,6 @@ subroutine read_saphir(mype,val_tovs,ithin,isfcalc,& ! hdr2b ='AGIND SOZA BEARAZ SOLAZI' ! AGIND instead of SAZA ! Loop to read bufr file - irec=0 read_subset: do while(ireadmg(lnbufr,subset,idate)>=0 .AND. iob < maxobs) read_loop: do while (ireadsb(lnbufr)==0 .and. iob < maxobs) @@ -601,8 +600,10 @@ subroutine read_saphir(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 do n=1,ndata diff --git a/src/gsi/read_ssmi.f90 b/src/gsi/read_ssmi.f90 index cece78ac03..ac5d251adf 100755 --- a/src/gsi/read_ssmi.f90 +++ b/src/gsi/read_ssmi.f90 @@ -142,7 +142,7 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& character(8) subset - integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,next + integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,next, number_profiles integer(i_kind):: iret,idate,nchanl integer(i_kind):: isflg,nreal,idomsfc integer(i_kind):: nmind,itx,nele,itt @@ -513,11 +513,13 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& end do read_subset call closbf(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) write(6,*) 'READ_SSMI: after combine_obs, nread,ndata is ',nread,ndata diff --git a/src/gsi/read_ssmis.f90 b/src/gsi/read_ssmis.f90 index c6a1af2263..25ab7a9c6c 100755 --- a/src/gsi/read_ssmis.f90 +++ b/src/gsi/read_ssmis.f90 @@ -153,7 +153,7 @@ subroutine read_ssmis(mype,val_ssmis,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind) :: i,k,ifovoff,ntest integer(i_kind) :: nlv,idate,nchanl,nreal - integer(i_kind) :: n,ireadsb,ireadmg,irec + integer(i_kind) :: n,ireadsb,ireadmg,irec, number_profiles integer(i_kind) :: nmind,itx,nele,itt integer(i_kind) :: iskip integer(i_kind) :: lnbufr,isflg,idomsfc(1) @@ -811,11 +811,13 @@ subroutine read_ssmis(mype,val_ssmis,ithin,isfcalc,rmesh,jsatid,gstime,& deallocate(solazi_save) deallocate(bt_save) + 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. diff --git a/src/gsi/read_viirs.f90 b/src/gsi/read_viirs.f90 index 3ea50352ec..17b23328e2 100644 --- a/src/gsi/read_viirs.f90 +++ b/src/gsi/read_viirs.f90 @@ -123,7 +123,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& real(r_double), dimension(10) :: hdr real(r_double), dimension(2,3) :: 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 @@ -469,10 +469,10 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& enddo read_msg call closbf(lnbufr) - + number_profiles = count(nrec(:) /= 999999,dim=1) 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,a11,I3,F6.1,3I10)') 'read_viirs,jsatid,imesh,amesh,itxmax,nread,ndata_mesh :',jsatid,imesh,amesh(imesh),itxmax,nread,ndata_mesh From a430c50293c6acad3f5ab247d6cb401f3079e9b8 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Tue, 3 Sep 2024 14:28:30 +0000 Subject: [PATCH 04/12] Added some comments. No actual code changes. --- src/gsi/read_abi.f90 | 1 + src/gsi/read_aerosol.f90 | 1 + src/gsi/read_ahi.f90 | 1 + src/gsi/read_airs.f90 | 1 + src/gsi/read_amsr2.f90 | 1 + src/gsi/read_amsre.f90 | 1 + src/gsi/read_atms.f90 | 1 + src/gsi/read_avhrr.f90 | 5 +++-- src/gsi/read_avhrr_navy.f90 | 1 + src/gsi/read_bufrtovs.f90 | 1 + src/gsi/read_cris.f90 | 1 + src/gsi/read_gmi.f90 | 1 + src/gsi/read_goesimg.f90 | 1 + src/gsi/read_goesndr.f90 | 1 + src/gsi/read_iasi.f90 | 5 +++-- src/gsi/read_saphir.f90 | 1 + src/gsi/read_ssmi.f90 | 1 + src/gsi/read_ssmis.f90 | 1 + src/gsi/read_viirs.f90 | 1 + 19 files changed, 23 insertions(+), 4 deletions(-) diff --git a/src/gsi/read_abi.f90 b/src/gsi/read_abi.f90 index 40f8f8e3be..50c7ac9b11 100644 --- a/src/gsi/read_abi.f90 +++ b/src/gsi/read_abi.f90 @@ -501,6 +501,7 @@ 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) diff --git a/src/gsi/read_aerosol.f90 b/src/gsi/read_aerosol.f90 index 09a0419846..b7b36fcfc2 100644 --- a/src/gsi/read_aerosol.f90 +++ b/src/gsi/read_aerosol.f90 @@ -351,6 +351,7 @@ 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,& diff --git a/src/gsi/read_ahi.f90 b/src/gsi/read_ahi.f90 index b54a835d7b..39626c7a7c 100644 --- a/src/gsi/read_ahi.f90 +++ b/src/gsi/read_ahi.f90 @@ -512,6 +512,7 @@ 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) diff --git a/src/gsi/read_airs.f90 b/src/gsi/read_airs.f90 index 9647d4af8e..b33e40ea29 100644 --- a/src/gsi/read_airs.f90 +++ b/src/gsi/read_airs.f90 @@ -861,6 +861,7 @@ subroutine read_airs(mype,val_airs,ithin,isfcalc,rmesh,jsatid,gstime,& 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) diff --git a/src/gsi/read_amsr2.f90 b/src/gsi/read_amsr2.f90 index cfbf60089e..594a14c5fe 100644 --- a/src/gsi/read_amsr2.f90 +++ b/src/gsi/read_amsr2.f90 @@ -659,6 +659,7 @@ 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 diff --git a/src/gsi/read_amsre.f90 b/src/gsi/read_amsre.f90 index d36e34a4e2..3ec89840f6 100755 --- a/src/gsi/read_amsre.f90 +++ b/src/gsi/read_amsre.f90 @@ -645,6 +645,7 @@ 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) diff --git a/src/gsi/read_atms.f90 b/src/gsi/read_atms.f90 index 47884b7909..9a05391aed 100644 --- a/src/gsi/read_atms.f90 +++ b/src/gsi/read_atms.f90 @@ -792,6 +792,7 @@ 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,& diff --git a/src/gsi/read_avhrr.f90 b/src/gsi/read_avhrr.f90 index 3e02af0d45..c42a95907e 100755 --- a/src/gsi/read_avhrr.f90 +++ b/src/gsi/read_avhrr.f90 @@ -563,10 +563,11 @@ 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) +! 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,number_profiles,ndata_mesh,data_mesh,score_crit,nrec) diff --git a/src/gsi/read_avhrr_navy.f90 b/src/gsi/read_avhrr_navy.f90 index 817028498d..ced3eb989a 100644 --- a/src/gsi/read_avhrr_navy.f90 +++ b/src/gsi/read_avhrr_navy.f90 @@ -464,6 +464,7 @@ 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,& diff --git a/src/gsi/read_bufrtovs.f90 b/src/gsi/read_bufrtovs.f90 index 5e0fde2c04..f34030dfc3 100644 --- a/src/gsi/read_bufrtovs.f90 +++ b/src/gsi/read_bufrtovs.f90 @@ -1061,6 +1061,7 @@ 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,& diff --git a/src/gsi/read_cris.f90 b/src/gsi/read_cris.f90 index 38e820e7e0..a3a5a95881 100644 --- a/src/gsi/read_cris.f90 +++ b/src/gsi/read_cris.f90 @@ -1013,6 +1013,7 @@ 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 diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 27bff7000d..2ed2bf44e5 100644 --- a/src/gsi/read_gmi.f90 +++ b/src/gsi/read_gmi.f90 @@ -782,6 +782,7 @@ 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 diff --git a/src/gsi/read_goesimg.f90 b/src/gsi/read_goesimg.f90 index 4de04e6969..8ca1171537 100644 --- a/src/gsi/read_goesimg.f90 +++ b/src/gsi/read_goesimg.f90 @@ -410,6 +410,7 @@ 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,& diff --git a/src/gsi/read_goesndr.f90 b/src/gsi/read_goesndr.f90 index 041437e367..223c57aac4 100644 --- a/src/gsi/read_goesndr.f90 +++ b/src/gsi/read_goesndr.f90 @@ -515,6 +515,7 @@ 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 diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index d2f9157a38..77471e39da 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -970,8 +970,6 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& end do ears_db_loop - number_profiles = count(nrec(:) /= 999999,dim=1) - deallocate(temperature, allchan, bufr_chan_test,scalef) deallocate(channel_number,sc_index) deallocate(bufr_index) @@ -980,6 +978,9 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& if (error_status /= success) & write(6,*)'OBSERVER: ***ERROR*** crtm_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 diff --git a/src/gsi/read_saphir.f90 b/src/gsi/read_saphir.f90 index 18f070b479..d0a70707b0 100644 --- a/src/gsi/read_saphir.f90 +++ b/src/gsi/read_saphir.f90 @@ -600,6 +600,7 @@ subroutine read_saphir(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,& diff --git a/src/gsi/read_ssmi.f90 b/src/gsi/read_ssmi.f90 index ac5d251adf..0887d351c3 100755 --- a/src/gsi/read_ssmi.f90 +++ b/src/gsi/read_ssmi.f90 @@ -513,6 +513,7 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& end do read_subset call closbf(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 diff --git a/src/gsi/read_ssmis.f90 b/src/gsi/read_ssmis.f90 index 25ab7a9c6c..c6f77aa79f 100755 --- a/src/gsi/read_ssmis.f90 +++ b/src/gsi/read_ssmis.f90 @@ -811,6 +811,7 @@ subroutine read_ssmis(mype,val_ssmis,ithin,isfcalc,rmesh,jsatid,gstime,& deallocate(solazi_save) deallocate(bt_save) +! 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 diff --git a/src/gsi/read_viirs.f90 b/src/gsi/read_viirs.f90 index 17b23328e2..9edf0a0882 100644 --- a/src/gsi/read_viirs.f90 +++ b/src/gsi/read_viirs.f90 @@ -469,6 +469,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& 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,& From 08624d64ae12f78ca82ffe05015da8b050de9758 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Thu, 5 Sep 2024 22:43:20 +0000 Subject: [PATCH 05/12] This change fixes the debug failure problem. --- src/gsi/read_iasi.f90 | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 77471e39da..2c055747a7 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -219,7 +219,7 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind):: error_status, irecx,ierr integer(i_kind):: radedge_min, radedge_max integer(i_kind) :: subset_start, subset_end, satinfo_nchan, sc_chan, bufr_chan - integer(i_kind) :: sfc_channel_index, number_profiles + integer(i_kind) :: sfc_channel_index integer(i_kind),allocatable, dimension(:) :: channel_number, sc_index, bufr_index integer(i_kind),allocatable, dimension(:) :: bufr_chan_test character(len=20),allocatable, dimension(:):: sensorlist @@ -711,14 +711,14 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& iexponent = -(nint(cscale(3,i)) - 5) sscale(i)=ten**iexponent else - sscale(i)= zero + sscale(i)=0.0_r_kind endif end do ! Read IASI channel number(CHNM) and radiance (SCRA) call ufbseq(lnbufr,allchan,2,bufr_nchan,iret,'IASICHN') jstart=1 - scalef=zero + scalef=one do i=1,bufr_nchan scaleloop: do j=jstart,10 if(allchan(1,i) >= cscale(1,j) .and. allchan(1,i) <= cscale(2,j))then @@ -757,19 +757,18 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& cycle read_loop endif - temperature(:) = tbmin !$omp parallel do schedule(dynamic,1) private(i,sc_chan,bufr_chan,radiance) channel_loop: do i=1,satinfo_nchan + sc_chan = sc_index(i) + if ( bufr_index(i) == 0 ) cycle channel_loop bufr_chan = bufr_index(i) - if (bufr_chan > 0 ) then -! check that channel number is within reason - if (( allchan(2,bufr_chan) > zero .and. allchan(2,bufr_chan) < 99999._r_kind) & ! radiance bounds - .and. scalef(bufr_chan) > zero ) then ! radiance scale factor exists - radiance = allchan(2,bufr_chan)*scalef(bufr_chan) - sc_chan = sc_index(i) - call crtm_planck_temperature(sensorindex_iasi,sc_chan,radiance,temperature(bufr_chan)) - endif - end if +! check that channel number is within reason + if (( allchan(2,bufr_chan) > zero .and. allchan(2,bufr_chan) < 99999._r_kind)) then ! radiance bounds + radiance = allchan(2,bufr_chan)*scalef(bufr_chan) + call crtm_planck_temperature(sensorindex_iasi,sc_chan,radiance,temperature(bufr_chan)) + else + temperature(bufr_chan) = tbmin + endif end do channel_loop ! Check for reasonable temperature values @@ -777,8 +776,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& skip_loop: do i=1,satinfo_nchan if ( bufr_index(i) == 0 ) cycle skip_loop bufr_chan = bufr_index(i) - if(temperature(bufr_chan) <= tbmin .or. temperature(bufr_chan) >= tbmax ) then - temperature(bufr_chan) = tbmin + if(temperature(bufr_chan) <= tbmin .or. temperature(bufr_chan) > tbmax ) then + temperature(bufr_chan) = min(tbmax,max(tbmin,temperature(bufr_chan))) if(iuse_rad(ioff+i) >= 0)iskip = iskip + 1 endif end do skip_loop @@ -950,10 +949,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& ! Put satinfo defined channel temperatures into data array do l=1,satinfo_nchan - ! Prevent out of bounds reference from temperature - if ( bufr_index(l) == 0 ) cycle i = bufr_index(l) - if(i /= 0)then + if(bufr_index(l) /= 0)then data_all(l+nreal,itx) = temperature(i) ! brightness temerature else data_all(l+nreal,itx) = tbmin @@ -978,14 +975,11 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& if (error_status /= success) & write(6,*)'OBSERVER: ***ERROR*** crtm_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,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. From 45019c5a2c50ecdcaba82453b0de382ae784f404 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Fri, 6 Sep 2024 15:10:50 +0000 Subject: [PATCH 06/12] This change makes read_iasi consistent with the other calls to combine_radobs. --- src/gsi/read_iasi.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 2c055747a7..13fe319bd3 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -211,7 +211,7 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind) :: ifov, instr, iscn, ioff, sensorindex_iasi integer(i_kind) :: i, j, l, iskip, ifovn, bad_line, ksatid, kidsat, llll - integer(i_kind) :: nreal, isflg + integer(i_kind) :: nreal, isflg, number_profiles integer(i_kind) :: itx, k, nele, itt, n integer(i_kind):: iexponent,maxinfo, bufr_nchan, dval_info integer(i_kind):: idomsfc(1) @@ -975,11 +975,14 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& if (error_status /= success) & write(6,*)'OBSERVER: ***ERROR*** crtm_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,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. From a41a78aa0c39dce6ca3ece386bf066e43987468b Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Wed, 11 Sep 2024 19:45:58 +0000 Subject: [PATCH 07/12] These changes make the number of observations read (nread) independent of the thinning routine (itxmax). --- src/gsi/combine_radobs.f90 | 6 ++++-- src/gsi/read_abi.f90 | 2 +- src/gsi/read_aerosol.f90 | 6 ++++-- src/gsi/read_ahi.f90 | 2 +- src/gsi/read_amsr2.f90 | 2 +- src/gsi/read_amsre.f90 | 2 +- src/gsi/read_atms.f90 | 2 +- src/gsi/read_avhrr.f90 | 2 +- src/gsi/read_avhrr_navy.f90 | 2 +- src/gsi/read_bufrtovs.f90 | 2 +- src/gsi/read_cris.f90 | 2 +- src/gsi/read_gmi.f90 | 2 +- src/gsi/read_goesimg.f90 | 2 +- src/gsi/read_goesndr.f90 | 2 +- src/gsi/read_iasi.f90 | 2 +- src/gsi/read_saphir.f90 | 2 +- src/gsi/read_seviri.f90 | 2 +- src/gsi/read_ssmi.f90 | 2 +- src/gsi/read_ssmis.f90 | 2 +- src/gsi/read_viirs.f90 | 2 +- 20 files changed, 26 insertions(+), 22 deletions(-) diff --git a/src/gsi/combine_radobs.f90 b/src/gsi/combine_radobs.f90 index 5c32188748..9dc794435c 100644 --- a/src/gsi/combine_radobs.f90 +++ b/src/gsi/combine_radobs.f90 @@ -1,5 +1,5 @@ subroutine combine_radobs(mype_sub,mype_root,& - npe_sub,mpi_comm_sub,nele,itxmax,nread,ndata,& + npe_sub,mpi_comm_sub,nele,itxmax,nread,number_profiles,ndata,& data_all,data_crit,nrec) !$$$ subprogram documentation block ! . . . . @@ -24,6 +24,7 @@ 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 ! @@ -50,6 +51,7 @@ 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),dimension(itxmax) ,intent(in ) :: nrec real(r_kind),dimension(itxmax) ,intent(inout) :: data_crit @@ -83,7 +85,7 @@ subroutine combine_radobs(mype_sub,mype_root,& ! is only needed on task mype_root call mpi_allreduce(data_crit,data_crit_min,itxmax,mpi_rtype,mpi_min,mpi_comm_sub,ierror) - allocate(nloc(min(ncounts1,itxmax)),icrit(min(ncounts1,itxmax))) + allocate(nloc(itxmax),icrit(itxmax)) icrit=1e9 ndata=0 ndata1=0 diff --git a/src/gsi/read_abi.f90 b/src/gsi/read_abi.f90 index 50c7ac9b11..f5cfa07d57 100644 --- a/src/gsi/read_abi.f90 +++ b/src/gsi/read_abi.f90 @@ -508,7 +508,7 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,& close(lnbufr) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_aerosol.f90 b/src/gsi/read_aerosol.f90 index b7b36fcfc2..7b7a513b01 100644 --- a/src/gsi/read_aerosol.f90 +++ b/src/gsi/read_aerosol.f90 @@ -355,7 +355,7 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, & number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - naerodat,itxmax,number_profiles,ndata,aeroout,score_crit,nrec) + naerodat,itxmax,nread,number_profiles,ndata,aeroout,score_crit,nrec) if ( mype_sub == mype_root ) then do n = 1, ndata @@ -582,8 +582,10 @@ 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,ndata,aeroout,score_crit,nrec) + naerodat,itxmax,nread,number_profiles,ndata,aeroout,score_crit,nrec) if ( mype_sub == mype_root ) then do n = 1, ndata diff --git a/src/gsi/read_ahi.f90 b/src/gsi/read_ahi.f90 index 39626c7a7c..e56e1ac5ca 100644 --- a/src/gsi/read_ahi.f90 +++ b/src/gsi/read_ahi.f90 @@ -519,7 +519,7 @@ subroutine read_ahi(mype,val_img,ithin,rmesh,jsatid,gstime,& close(lnbufr) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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 diff --git a/src/gsi/read_amsr2.f90 b/src/gsi/read_amsr2.f90 index 594a14c5fe..759034c254 100644 --- a/src/gsi/read_amsr2.f90 +++ b/src/gsi/read_amsr2.f90 @@ -666,7 +666,7 @@ subroutine read_amsr2(mype,val_amsr2,ithin,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_amsre.f90 b/src/gsi/read_amsre.f90 index 3ec89840f6..1a0bdf564a 100755 --- a/src/gsi/read_amsre.f90 +++ b/src/gsi/read_amsre.f90 @@ -655,7 +655,7 @@ subroutine read_amsre(mype,val_amsre,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) ! Allow single task to check for bad obs, update superobs sum, diff --git a/src/gsi/read_atms.f90 b/src/gsi/read_atms.f90 index 9a05391aed..67c528d9b2 100644 --- a/src/gsi/read_atms.f90 +++ b/src/gsi/read_atms.f90 @@ -796,7 +796,7 @@ subroutine read_atms(mype,val_tovs,ithin,isfcalc,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) ! if(mype_sub==mype_root)then diff --git a/src/gsi/read_avhrr.f90 b/src/gsi/read_avhrr.f90 index c42a95907e..aae28b86c8 100755 --- a/src/gsi/read_avhrr.f90 +++ b/src/gsi/read_avhrr.f90 @@ -569,7 +569,7 @@ subroutine read_avhrr(mype,val_avhrr,ithin,rmesh,jsatid,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata_mesh,data_mesh,score_crit,nrec) + nele,itxmax,nread,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 diff --git a/src/gsi/read_avhrr_navy.f90 b/src/gsi/read_avhrr_navy.f90 index ced3eb989a..a44979715e 100644 --- a/src/gsi/read_avhrr_navy.f90 +++ b/src/gsi/read_avhrr_navy.f90 @@ -468,7 +468,7 @@ subroutine read_avhrr_navy(mype,val_avhrr,ithin,rmesh,jsatid,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) ! Now that we've identified the "best" observations, pull out best obs diff --git a/src/gsi/read_bufrtovs.f90 b/src/gsi/read_bufrtovs.f90 index f34030dfc3..fe05d8994c 100644 --- a/src/gsi/read_bufrtovs.f90 +++ b/src/gsi/read_bufrtovs.f90 @@ -1065,7 +1065,7 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) ! if(mype_sub==mype_root)then diff --git a/src/gsi/read_cris.f90 b/src/gsi/read_cris.f90 index a3a5a95881..56acf8ba8a 100644 --- a/src/gsi/read_cris.f90 +++ b/src/gsi/read_cris.f90 @@ -1020,7 +1020,7 @@ subroutine read_cris(mype,val_cris,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 2ed2bf44e5..163d20bff4 100644 --- a/src/gsi/read_gmi.f90 +++ b/src/gsi/read_gmi.f90 @@ -788,7 +788,7 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,& ! 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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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 diff --git a/src/gsi/read_goesimg.f90 b/src/gsi/read_goesimg.f90 index 8ca1171537..bdaa345299 100644 --- a/src/gsi/read_goesimg.f90 +++ b/src/gsi/read_goesimg.f90 @@ -414,7 +414,7 @@ subroutine read_goesimg(mype,val_img,ithin,rmesh,jsatid,gstime,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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 diff --git a/src/gsi/read_goesndr.f90 b/src/gsi/read_goesndr.f90 index 223c57aac4..05adc52f8a 100644 --- a/src/gsi/read_goesndr.f90 +++ b/src/gsi/read_goesndr.f90 @@ -522,7 +522,7 @@ subroutine read_goesndr(mype,val_goes,ithin,rmesh,jsatid,infile,& ! 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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) ! Allow single task to check for bad obs, update superobs sum, diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 13fe319bd3..8c854dac41 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -982,7 +982,7 @@ subroutine read_iasi(mype,val_iasi,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_saphir.f90 b/src/gsi/read_saphir.f90 index d0a70707b0..34aba7b4e7 100644 --- a/src/gsi/read_saphir.f90 +++ b/src/gsi/read_saphir.f90 @@ -604,7 +604,7 @@ subroutine read_saphir(mype,val_tovs,ithin,isfcalc,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) if(mype_sub==mype_root)then do n=1,ndata diff --git a/src/gsi/read_seviri.f90 b/src/gsi/read_seviri.f90 index 485ac4723a..cafe3cfe46 100644 --- a/src/gsi/read_seviri.f90 +++ b/src/gsi/read_seviri.f90 @@ -529,7 +529,7 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& 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,nread,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. diff --git a/src/gsi/read_ssmi.f90 b/src/gsi/read_ssmi.f90 index 0887d351c3..b1f2f98997 100755 --- a/src/gsi/read_ssmi.f90 +++ b/src/gsi/read_ssmi.f90 @@ -520,7 +520,7 @@ subroutine read_ssmi(mype,val_ssmi,ithin,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata,data_all,score_crit,nrec) write(6,*) 'READ_SSMI: after combine_obs, nread,ndata is ',nread,ndata diff --git a/src/gsi/read_ssmis.f90 b/src/gsi/read_ssmis.f90 index c6f77aa79f..53bbd3d6c2 100755 --- a/src/gsi/read_ssmis.f90 +++ b/src/gsi/read_ssmis.f90 @@ -818,7 +818,7 @@ subroutine read_ssmis(mype,val_ssmis,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,number_profiles,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_viirs.f90 b/src/gsi/read_viirs.f90 index 9edf0a0882..12db28e75d 100644 --- a/src/gsi/read_viirs.f90 +++ b/src/gsi/read_viirs.f90 @@ -473,7 +473,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,number_profiles,ndata_mesh,data_mesh,score_crit,nrec) + nele,itxmax,nread,number_profiles,ndata_mesh,data_mesh,score_crit,nrec) if ( nread > 0 ) then write(*,'(a,a11,I3,F6.1,3I10)') 'read_viirs,jsatid,imesh,amesh,itxmax,nread,ndata_mesh :',jsatid,imesh,amesh(imesh),itxmax,nread,ndata_mesh From d805b37bde64143aaeea673e78a941a27ab4c818 Mon Sep 17 00:00:00 2001 From: James Jung Date: Tue, 17 Sep 2024 07:30:28 -0400 Subject: [PATCH 08/12] Update src/gsi/read_iasi.f90 Co-authored-by: David Huber <69919478+DavidHuber-NOAA@users.noreply.github.com> --- src/gsi/read_iasi.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 8c854dac41..e274600007 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -762,7 +762,7 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& sc_chan = sc_index(i) if ( bufr_index(i) == 0 ) cycle channel_loop bufr_chan = bufr_index(i) -! check that channel number is within reason +! check that channel number is within reason if (( allchan(2,bufr_chan) > zero .and. allchan(2,bufr_chan) < 99999._r_kind)) then ! radiance bounds radiance = allchan(2,bufr_chan)*scalef(bufr_chan) call crtm_planck_temperature(sensorindex_iasi,sc_chan,radiance,temperature(bufr_chan)) From c142f292e6320d503d48a7ddbd7760fe0e3f98a1 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Tue, 17 Sep 2024 14:19:49 +0000 Subject: [PATCH 09/12] Changes to read_seviri.f90 are items missed in the initial coding and make this routine consistent with other satellite data read routines. The other two files are formatting changes. --- src/enkf/enkf_obs_sensitivity.f90 | 2 +- src/enkf/innovstats.f90 | 2 +- src/gsi/read_seviri.f90 | 4 +++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/enkf/enkf_obs_sensitivity.f90 b/src/enkf/enkf_obs_sensitivity.f90 index b257e23ee3..1b95b45a7a 100644 --- a/src/enkf/enkf_obs_sensitivity.f90 +++ b/src/enkf/enkf_obs_sensitivity.f90 @@ -547,7 +547,7 @@ subroutine print_ob_sens if(nob_sat(nchan) > 0) then rate_sat(nchan,1:3) = rate_sat(nchan,1:3) & & / real(nob_sat(nchan),r_kind) * 100._r_kind - write(*,'(a22,i6,i7,3(1x,e12.5),3(1x,f7.2))') & + write(*,'(a20,1x,i5,i7,3(1x,e12.5),3(1x,f7.2))') & & trim(adjustl(nusis(nchan))), & & nuchan(nchan),nob_sat(nchan),sumsense_sat(nchan,1:3), & & rate_sat(nchan,1:3) diff --git a/src/enkf/innovstats.f90 b/src/enkf/innovstats.f90 index 46b3719e8c..0abd12a919 100644 --- a/src/enkf/innovstats.f90 +++ b/src/enkf/innovstats.f90 @@ -278,7 +278,7 @@ subroutine print_innovstats(obfit,obsprd) sqrt(sumerr_sat(nchan)) end if end do -9805 format(a20,i6,1x,i5,5(1x,e10.3)) +9805 format(a20,1x,i5,1x,i5,5(1x,e10.3)) end if !nobs_sat>0 end subroutine print_innovstats diff --git a/src/gsi/read_seviri.f90 b/src/gsi/read_seviri.f90 index cafe3cfe46..7052868ae5 100644 --- a/src/gsi/read_seviri.f90 +++ b/src/gsi/read_seviri.f90 @@ -103,7 +103,7 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& integer(i_kind) nchanl,ilath,ilonh,ilzah,iszah,irec,next 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) itx,i,k,isflg,kidsat,n,iscan,idomsfc,number_profiles integer(i_kind) idate5(5),maxinfo integer(i_kind),allocatable,dimension(:)::nrec @@ -528,6 +528,8 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& call closbf(lnbufr) close(lnbufr) + number_profiles = count(nrec(:) /= 999999,dim=1) + call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& nele,itxmax,nread,nread,ndata,data_all,score_crit,nrec) From 02ef623da53a428251570d9366b8b29f9d5a1b08 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Wed, 18 Sep 2024 14:40:43 +0000 Subject: [PATCH 10/12] This commit backs out of defining and using profile_counts due to previous 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 | 10 ++++------ src/gsi/read_abi.f90 | 7 ++----- src/gsi/read_aerosol.f90 | 11 +++-------- src/gsi/read_ahi.f90 | 8 ++------ src/gsi/read_airs.f90 | 8 ++------ src/gsi/read_amsr2.f90 | 7 ++----- src/gsi/read_amsre.f90 | 8 ++------ src/gsi/read_atms.f90 | 7 ++----- src/gsi/read_avhrr.f90 | 8 ++------ src/gsi/read_avhrr_navy.f90 | 7 ++----- src/gsi/read_bufrtovs.f90 | 7 ++----- src/gsi/read_cris.f90 | 7 ++----- src/gsi/read_gmi.f90 | 8 ++------ src/gsi/read_goesimg.f90 | 7 ++----- src/gsi/read_goesndr.f90 | 6 ++---- src/gsi/read_iasi.f90 | 7 ++----- src/gsi/read_saphir.f90 | 7 ++----- src/gsi/read_seviri.f90 | 2 +- src/gsi/read_ssmi.f90 | 7 ++----- src/gsi/read_ssmis.f90 | 7 ++----- src/gsi/read_viirs.f90 | 7 +++---- 21 files changed, 45 insertions(+), 108 deletions(-) diff --git a/src/gsi/combine_radobs.f90 b/src/gsi/combine_radobs.f90 index 9dc794435c..b680c35648 100644 --- a/src/gsi/combine_radobs.f90 +++ b/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 diff --git a/src/gsi/read_abi.f90 b/src/gsi/read_abi.f90 index f5cfa07d57..eaa6b1675f 100644 --- a/src/gsi/read_abi.f90 +++ b/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. diff --git a/src/gsi/read_aerosol.f90 b/src/gsi/read_aerosol.f90 index 7b7a513b01..a58b2d4358 100644 --- a/src/gsi/read_aerosol.f90 +++ b/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 diff --git a/src/gsi/read_ahi.f90 b/src/gsi/read_ahi.f90 index e56e1ac5ca..5191bbee19 100644 --- a/src/gsi/read_ahi.f90 +++ b/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 diff --git a/src/gsi/read_airs.f90 b/src/gsi/read_airs.f90 index b33e40ea29..c5392dad14 100644 --- a/src/gsi/read_airs.f90 +++ b/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. diff --git a/src/gsi/read_amsr2.f90 b/src/gsi/read_amsr2.f90 index 759034c254..9d8d4944d9 100644 --- a/src/gsi/read_amsr2.f90 +++ b/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. diff --git a/src/gsi/read_amsre.f90 b/src/gsi/read_amsre.f90 index 1a0bdf564a..ef0c2ad2bb 100755 --- a/src/gsi/read_amsre.f90 +++ b/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,10 +644,6 @@ 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) @@ -655,7 +651,7 @@ subroutine read_amsre(mype,val_amsre,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,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, diff --git a/src/gsi/read_atms.f90 b/src/gsi/read_atms.f90 index 67c528d9b2..424843a7c1 100644 --- a/src/gsi/read_atms.f90 +++ b/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 diff --git a/src/gsi/read_avhrr.f90 b/src/gsi/read_avhrr.f90 index aae28b86c8..c1509828ad 100755 --- a/src/gsi/read_avhrr.f90 +++ b/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 diff --git a/src/gsi/read_avhrr_navy.f90 b/src/gsi/read_avhrr_navy.f90 index a44979715e..b21e653730 100644 --- a/src/gsi/read_avhrr_navy.f90 +++ b/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 diff --git a/src/gsi/read_bufrtovs.f90 b/src/gsi/read_bufrtovs.f90 index fe05d8994c..9bca8f5a7c 100644 --- a/src/gsi/read_bufrtovs.f90 +++ b/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 diff --git a/src/gsi/read_cris.f90 b/src/gsi/read_cris.f90 index 56acf8ba8a..2a899cecd6 100644 --- a/src/gsi/read_cris.f90 +++ b/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. diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 163d20bff4..6ad4d829a3 100644 --- a/src/gsi/read_gmi.f90 +++ b/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 !========================================================================================================= diff --git a/src/gsi/read_goesimg.f90 b/src/gsi/read_goesimg.f90 index bdaa345299..bf40a1f163 100644 --- a/src/gsi/read_goesimg.f90 +++ b/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 diff --git a/src/gsi/read_goesndr.f90 b/src/gsi/read_goesndr.f90 index 05adc52f8a..7c55b6ab4c 100644 --- a/src/gsi/read_goesndr.f90 +++ b/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, diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index e274600007..94e1577798 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -211,7 +211,7 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind) :: ifov, instr, iscn, ioff, sensorindex_iasi integer(i_kind) :: i, j, l, iskip, ifovn, bad_line, ksatid, kidsat, llll - integer(i_kind) :: nreal, isflg, number_profiles + integer(i_kind) :: nreal, isflg integer(i_kind) :: itx, k, nele, itt, n integer(i_kind):: iexponent,maxinfo, bufr_nchan, dval_info integer(i_kind):: idomsfc(1) @@ -975,14 +975,11 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& if (error_status /= success) & write(6,*)'OBSERVER: ***ERROR*** crtm_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. diff --git a/src/gsi/read_saphir.f90 b/src/gsi/read_saphir.f90 index 34aba7b4e7..dd421fd679 100644 --- a/src/gsi/read_saphir.f90 +++ b/src/gsi/read_saphir.f90 @@ -110,7 +110,7 @@ subroutine read_saphir(mype,val_tovs,ithin,isfcalc,& character(8) :: subset character(80) :: hdr1b,hdr2b - integer(i_kind) :: ireadsb,ireadmg, number_profiles + integer(i_kind) :: ireadsb,ireadmg integer(i_kind) :: i,j,k,ntest,iob integer(i_kind) :: iret,idate,nchanl,n,idomsfc(1) integer(i_kind) :: kidsat,maxinfo @@ -600,11 +600,8 @@ subroutine read_saphir(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 do n=1,ndata diff --git a/src/gsi/read_seviri.f90 b/src/gsi/read_seviri.f90 index 7052868ae5..a1bf3f727e 100644 --- a/src/gsi/read_seviri.f90 +++ b/src/gsi/read_seviri.f90 @@ -531,7 +531,7 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& number_profiles = count(nrec(:) /= 999999,dim=1) call combine_radobs(mype_sub,mype_root,npe_sub,mpi_comm_sub,& - nele,itxmax,nread,nread,ndata,data_all,score_crit,nrec) + nele,itxmax,nread,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. diff --git a/src/gsi/read_ssmi.f90 b/src/gsi/read_ssmi.f90 index b1f2f98997..cece78ac03 100755 --- a/src/gsi/read_ssmi.f90 +++ b/src/gsi/read_ssmi.f90 @@ -142,7 +142,7 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& character(8) subset - integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,next, number_profiles + integer(i_kind):: i,k,ntest,ireadsb,ireadmg,irec,next integer(i_kind):: iret,idate,nchanl integer(i_kind):: isflg,nreal,idomsfc integer(i_kind):: nmind,itx,nele,itt @@ -513,14 +513,11 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& end do read_subset call closbf(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) write(6,*) 'READ_SSMI: after combine_obs, nread,ndata is ',nread,ndata diff --git a/src/gsi/read_ssmis.f90 b/src/gsi/read_ssmis.f90 index 53bbd3d6c2..c6a1af2263 100755 --- a/src/gsi/read_ssmis.f90 +++ b/src/gsi/read_ssmis.f90 @@ -153,7 +153,7 @@ subroutine read_ssmis(mype,val_ssmis,ithin,isfcalc,rmesh,jsatid,gstime,& integer(i_kind) :: i,k,ifovoff,ntest integer(i_kind) :: nlv,idate,nchanl,nreal - integer(i_kind) :: n,ireadsb,ireadmg,irec, number_profiles + integer(i_kind) :: n,ireadsb,ireadmg,irec integer(i_kind) :: nmind,itx,nele,itt integer(i_kind) :: iskip integer(i_kind) :: lnbufr,isflg,idomsfc(1) @@ -811,14 +811,11 @@ subroutine read_ssmis(mype,val_ssmis,ithin,isfcalc,rmesh,jsatid,gstime,& deallocate(solazi_save) deallocate(bt_save) -! 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. diff --git a/src/gsi/read_viirs.f90 b/src/gsi/read_viirs.f90 index 12db28e75d..3ea50352ec 100644 --- a/src/gsi/read_viirs.f90 +++ b/src/gsi/read_viirs.f90 @@ -123,7 +123,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& real(r_double), dimension(10) :: hdr real(r_double), dimension(2,3) :: 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 @@ -469,11 +469,10 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,& 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,a11,I3,F6.1,3I10)') 'read_viirs,jsatid,imesh,amesh,itxmax,nread,ndata_mesh :',jsatid,imesh,amesh(imesh),itxmax,nread,ndata_mesh From d928aab9b4157ed1c1ea33b229dd2700bbd08bda Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Wed, 18 Sep 2024 23:14:33 +0000 Subject: [PATCH 11/12] Removed number_profile variables missed in the previous commit. --- src/gsi/read_seviri.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/gsi/read_seviri.f90 b/src/gsi/read_seviri.f90 index a1bf3f727e..485ac4723a 100644 --- a/src/gsi/read_seviri.f90 +++ b/src/gsi/read_seviri.f90 @@ -103,7 +103,7 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& integer(i_kind) nchanl,ilath,ilonh,ilzah,iszah,irec,next 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,number_profiles + integer(i_kind) itx,i,k,isflg,kidsat,n,iscan,idomsfc integer(i_kind) idate5(5),maxinfo integer(i_kind),allocatable,dimension(:)::nrec @@ -528,10 +528,8 @@ subroutine read_seviri(mype,val_sev,ithin,rmesh,jsatid,& call closbf(lnbufr) close(lnbufr) - 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) ! Allow single task to check for bad obs, update superobs sum, ! and write out data to scratch file for further processing. From 74947da5067ee0c52395a2ebb5e7233d19ddf9f8 Mon Sep 17 00:00:00 2001 From: wx20jjung Date: Fri, 20 Sep 2024 00:39:35 +0000 Subject: [PATCH 12/12] Made write statements to fort.207 consistent in radinfo.f90. nrec was initialized twice in read_gmi.f90, once before and after it was allocated. I removed the first instance. --- src/gsi/radinfo.f90 | 2 +- src/gsi/read_gmi.f90 | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/gsi/radinfo.f90 b/src/gsi/radinfo.f90 index 2abc4c7b04..e7624fab70 100644 --- a/src/gsi/radinfo.f90 +++ b/src/gsi/radinfo.f90 @@ -805,7 +805,7 @@ subroutine radinfo_read end do close(lunin) 100 format(a1,a120) -110 format(i6,1x,a20,' chan= ',i5, & +110 format(i5,1x,a20,' chan= ',i5, & ' var= ',f7.3,' varch_cld=',f7.3,' use= ',i2,' ermax= ',F7.3, & ' b_rad= ',F7.2,' pg_rad=',F7.2,' icld_det=',I2,' icloud=',I2,' iaeros=',I2) 111 format(i4,1x,a20,' chan= ',i5, & diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 6ad4d829a3..d02520d7e0 100644 --- a/src/gsi/read_gmi.f90 +++ b/src/gsi/read_gmi.f90 @@ -346,7 +346,6 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,& next=0 irec=0 iobs=1 - nrec=999999 read_subset: do while(ireadmg(lnbufr,subset,idate)>=0) ! GMI scans irec=irec+1