diff --git a/src/gsi/combine_radobs.f90 b/src/gsi/combine_radobs.f90 index 5c3218874..9dc794435 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 50c7ac9b1..f5cfa07d5 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 b7b36fcfc..7b7a513b0 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 39626c7a7..e56e1ac5c 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 594a14c5f..759034c25 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 3ec89840f..1a0bdf564 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 9a05391ae..67c528d9b 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 c42a95907..aae28b86c 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 ced3eb989..a44979715 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 f34030dfc..fe05d8994 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 a3a5a9588..56acf8ba8 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 2ed2bf44e..163d20bff 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 8ca117153..bdaa34529 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 223c57aac..05adc52f8 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 13fe319bd..8c854dac4 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 d0a70707b..34aba7b4e 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 485ac4723..cafe3cfe4 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 0887d351c..b1f2f9899 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 c6f77aa79..53bbd3d6c 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 9edf0a088..12db28e75 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