Skip to content

Commit

Permalink
Format changes for EUMETSAT metop-sg and CADS debug fix (#773)
Browse files Browse the repository at this point in the history
  • Loading branch information
@wx20jjung
wx20jjung committed Jul 31, 2024
1 parent 3e27bb8 commit de74bb2
Show file tree
Hide file tree
Showing 11 changed files with 144 additions and 119 deletions.
2 changes: 1 addition & 1 deletion src/gsi/gsimod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2320,7 +2320,7 @@ subroutine gsimain_initialize
endif
do i=1,ndat
write(6,401)dfile(i),dtype(i),dplat(i),dsis(i),dval(i),dthin(i),dsfcalc(i),time_window(i)
401 format(1x,a20,1x,a10,1x,a10,1x,a20,1x,f10.2,1x,I3,1x,I3,1x,f10.2)
401 format(1x,a20,1x,a10,1x,a11,1x,a20,1x,f10.2,1x,I3,1x,I3,1x,f10.2)
end do
write(6,superob_radar)
write(6,lag_data)
Expand Down
7 changes: 5 additions & 2 deletions src/gsi/mrmsmod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,9 @@ subroutine load_mrms_data_info (mrms_listfile,nrows0,ntot_mrms,nrows_mrms,nrows,
integer(i_kind),parameter::nobstype_mrms=2 ! first for vr, and the second for ref
integer(i_kind),intent(in):: nrows0,ntot_mrms,nrows_mrms,nrows
character(len=*),intent(in),optional ::mrms_listfile, rcname ! input filename
character(10),intent(inout),dimension(nrows):: dtype,ditype,dplat
character(len=*),intent(inout),dimension(nrows):: dtype
character(len=*),intent(inout),dimension(nrows):: ditype
character(len=*),intent(inout),dimension(nrows):: dplat
character(20),intent(inout),dimension(nrows):: obsfile_all
character(*),intent(inout),dimension(nrows):: dfile
character(20),intent(inout),dimension(nrows):: dsis
Expand All @@ -42,7 +44,8 @@ subroutine load_mrms_data_info (mrms_listfile,nrows0,ntot_mrms,nrows_mrms,nrows,


real(r_kind),allocatable,dimension(:):: dmesh_mrms
character(10),allocatable,dimension(:):: dtype_mrms,ditype_mrms,dplat_mrms
character(10),allocatable,dimension(:):: dtype_mrms,ditype_mrms
character(11),allocatable,dimension(:):: dplat_mrms
character(120),allocatable,dimension(:):: dfile_mrms
character(20),allocatable,dimension(:):: dsis_mrms
real(r_kind) ,allocatable,dimension(:):: dval_mrms
Expand Down
3 changes: 2 additions & 1 deletion src/gsi/obsmod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -626,7 +626,8 @@ module obsmod
character(128) dirname
character(128) obs_input_common
character(20),allocatable,dimension(:):: obsfile_all
character(10),allocatable,dimension(:):: dtype,ditype,dplat
character(10),allocatable,dimension(:):: dtype,ditype
character(11),allocatable,dimension(:):: dplat
character(120),allocatable,dimension(:):: dfile
character(20),allocatable,dimension(:):: dsis
real(r_kind) ,allocatable,dimension(:):: dval
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/qcmod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4240,7 +4240,7 @@ subroutine qc_goesimg(nchanl,is,ndat,nsig,ich,dplat,sea,land,ice,snow,luse, &
real(r_kind),dimension(nsig,nchanl),intent(in ) :: temp,wmix
real(r_kind),dimension(nchanl), intent(in ) :: tb_obs,tb_obs_sdv,tbc,tnoise,emissivity_k,ts
real(r_kind),dimension(nchanl), intent(inout) :: errf,varinv
character(10), intent(in ) :: dplat
character(len=*), intent(in ) :: dplat

! Declare local parameters

Expand Down
4 changes: 2 additions & 2 deletions src/gsi/radinfo.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -805,10 +805,10 @@ subroutine radinfo_read
end do
close(lunin)
100 format(a1,a120)
110 format(i4,1x,a20,' chan= ',i4, &
110 format(i4,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= ',i4, &
111 format(i4,1x,a20,' chan= ',i5, &
' var= ',f7.3,' varch_cld=',f7.3,' use= ',i2,' ermax= ',F7.3, &
' b_rad= ',F7.2,' pg_rad=',F7.2,' iextra_det=',I2, 'icloud=',I2,'iaeros=', I2)

Expand Down
89 changes: 49 additions & 40 deletions src/gsi/read_cris.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,9 +112,9 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
integer(i_kind) ,intent(in ) :: mype_sub
integer(i_kind) ,intent(in ) :: npe_sub
integer(i_kind) ,intent(in ) :: mpi_comm_sub
character(len=*), intent(in ) :: infile
character(len=10),intent(in ) :: jsatid
character(len=*), intent(in ) :: obstype
character(len=*) ,intent(in ) :: infile
character(len=*) ,intent(in ) :: jsatid
character(len=*) ,intent(in ) :: obstype
character(len=20),intent(in ) :: sis
real(r_kind) ,intent(in ) :: twind
real(r_kind) ,intent(inout) :: val_cris
Expand Down Expand Up @@ -200,7 +200,6 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
real(r_kind),dimension(83,7) :: imager_info
real(r_kind),dimension(7) :: imager_cluster_size
real(r_kind),dimension(2) :: imager_mean, imager_std_dev, imager_conversion
real(r_kind) :: imager_cluster_tot

! bufr error codes
! real(r_kind),dimension(7,3) :: error_codes
Expand Down Expand Up @@ -848,10 +847,9 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
if ( cris_cads ) then
call ufbseq(lnbufr,imager_info,83,7,iret,'CRISCS')
if ( iret == 7 .and. imager_info(3,1) <= 100.0_r_kind .and. &
imager_info(3,1) >= zero .and. imager_coeff ) then ! if imager cluster info exists
sum(imager_info(3,:)) > zero .and. imager_coeff ) then ! if imager cluster info exists
imager_mean = zero
imager_std_dev = zero
imager_cluster_tot = zero
imager_cluster_flag = .TRUE.
imager_cluster_size = imager_info(3,1:7)
imager_cluster_size(:) = imager_cluster_size(:) / sum(imager_cluster_size(:))
Expand All @@ -871,51 +869,62 @@ subroutine read_cris(mype,val_cris,ithin,isfcalc,rmesh,jsatid,gstime,&
imager_cluster_info: do j=1,7
i = imager_cluster_index(j)

data_all(maxinfo+j,itx) = imager_cluster_size(i) ! Imager cluster fraction
imager_cluster_tot = imager_cluster_tot + imager_info(3,i)
! If the cluster size, or radiance values of channel 4 or 5 are zero, do not compute statistics for that cluster

iexponent = -(nint(imager_info(75,i)) -11) ! channel 15 radiance for each cluster
imager_info(76,i) = imager_info(76,i) * imager_conversion(1) * (ten ** iexponent)
if ( imager_cluster_size(i) > zero .and. imager_info(76,i) > zero .and. imager_info(81,i) > zero ) then
data_all(maxinfo+j,itx) = imager_cluster_size(i) ! Imager cluster fraction

iexponent = -(nint(imager_info(77,i)) -11) ! channel 15 radiance std dev for each cluster.
imager_info(78,i) = imager_info(78,i) * imager_conversion(1) * (ten ** iexponent)
iexponent = -(nint(imager_info(75,i)) -11) ! channel 15 radiance for each cluster
imager_info(76,i) = imager_info(76,i) * imager_conversion(1) * (ten ** iexponent)

call crtm_planck_temperature(sensorindex_imager,4,imager_info(76,i),data_all(maxinfo+7+j,itx))
data_all(maxinfo+7+j,itx) = max(data_all(maxinfo+7+j,itx),zero)
iexponent = -(nint(imager_info(77,i)) -11) ! channel 15 radiance std dev for each cluster.
imager_info(78,i) = imager_info(78,i) * imager_conversion(1) * (ten ** iexponent)

iexponent = -(nint(imager_info(80,i)) -11) ! channel 16 radiance for each cluster
imager_info(81,i) = imager_info(81,i) * imager_conversion(2) * (ten ** iexponent)
iexponent = -(nint(imager_info(80,i)) -11) ! channel 16 radiance for each cluster
imager_info(81,i) = imager_info(81,i) * imager_conversion(2) * (ten ** iexponent)

iexponent = -(nint(imager_info(82,i))-5 ) ! channel 16 radiance std dev for each cluster.
iexponent = -(nint(imager_info(82,i)) -11) ! channel 16 radiance std dev for each cluster.
imager_info(83,i) = imager_info(83,i) * imager_conversion(2) * (ten ** iexponent)
iexponent = -(nint(imager_info(82,i)) -11) ! channel 16 radiance std dev for each cluster.
imager_info(83,i) = imager_info(83,i) * imager_conversion(2) * (ten ** iexponent)

call crtm_planck_temperature(sensorindex_imager,5,imager_info(81,i),data_all(maxinfo+14+j,itx))
data_all(maxinfo+14+j,itx) = max(data_all(maxinfo+14+j,itx),zero)


end do imager_cluster_info
call crtm_planck_temperature(sensorindex_imager,4,imager_info(76,i),data_all(maxinfo+7+j,itx))
data_all(maxinfo+7+j,itx) = max(data_all(maxinfo+7+j,itx),zero)
call crtm_planck_temperature(sensorindex_imager,5,imager_info(81,i),data_all(maxinfo+14+j,itx))
data_all(maxinfo+14+j,itx) = max(data_all(maxinfo+14+j,itx),zero)
else
data_all(maxinfo+j,itx) = zero ! something is wrong
data_all(maxinfo+7+j,itx) = zero ! set everything to zero
data_all(maxinfo+14+j,itx) = zero
endif
end do imager_cluster_info

! Compute cluster averages for each channel

imager_mean(1) = sum(imager_cluster_size(:) * imager_info(76,:)) ! Channel 15 radiance cluster average
imager_std_dev(1) = sum(imager_cluster_size(:) * (imager_info(76,:)**2 + imager_info(78,:)**2)) - imager_mean(1)**2
imager_std_dev(1) = sqrt(max(imager_std_dev(1),zero)) ! Channel 15 radiance RMSE
call crtm_planck_temperature(sensorindex_imager,4,(imager_std_dev(1) + imager_mean(1)),imager_std_dev(1))
call crtm_planck_temperature(sensorindex_imager,4,imager_mean(1),imager_mean(1)) ! Channel 15 average BT
imager_std_dev(1) = imager_std_dev(1) - imager_mean(1) ! Channel 15 BT std dev
data_all(maxinfo+22,itx) = imager_std_dev(1)

imager_mean(2) = sum(imager_cluster_size(:) * imager_info(81,:)) ! Channel 16 radiance cluster average
imager_std_dev(2) = sum(imager_cluster_size(:) * (imager_info(81,:)**2 + imager_info(83,:)**2)) - imager_mean(1)**2
imager_std_dev(2) = sqrt(max(imager_std_dev(1),zero)) ! Channel 16 radiance RMSE
call crtm_planck_temperature(sensorindex_imager,5,(imager_std_dev(2) + imager_mean(2)),imager_std_dev(2))
call crtm_planck_temperature(sensorindex_imager,5,imager_mean(2),imager_mean(2)) ! Channel 16 average BT
imager_std_dev(2) = imager_std_dev(2) - imager_mean(2) ! Channel 16 BT std dev
data_all(maxinfo+23,itx) = imager_std_dev(2)
imager_mean(1) = sum(imager_cluster_size(:) * imager_info(76,:)) ! Channel 15 radiance cluster average
imager_std_dev(1) = sum(imager_cluster_size(:) * (imager_info(76,:)**2 + imager_info(78,:)**2)) - imager_mean(1)**2
imager_std_dev(1) = sqrt(max(imager_std_dev(1),zero)) ! Channel 15 radiance RMSE
if ( imager_mean(1) > zero .and. imager_std_dev(1) > zero ) then
call crtm_planck_temperature(sensorindex_imager,4,(imager_std_dev(1) + imager_mean(1)),imager_std_dev(1))
call crtm_planck_temperature(sensorindex_imager,4,imager_mean(1),imager_mean(1)) ! Channel 15 average BT
imager_std_dev(1) = imager_std_dev(1) - imager_mean(1) ! Channel 15 BT std dev
data_all(maxinfo+22,itx) = imager_std_dev(1)
else
data_all(maxinfo+22,itx) = zero
endif

imager_mean(2) = sum(imager_cluster_size(:) * imager_info(81,:)) ! Channel 16 radiance cluster average
imager_std_dev(2) = sum(imager_cluster_size(:) * (imager_info(81,:)**2 + imager_info(83,:)**2)) - imager_mean(1)**2
imager_std_dev(2) = sqrt(max(imager_std_dev(1),zero)) ! Channel 16 radiance RMSE
if ( imager_mean(2) > zero .and. imager_std_dev(2) > zero ) then
call crtm_planck_temperature(sensorindex_imager,5,(imager_std_dev(2) + imager_mean(2)),imager_std_dev(2))
call crtm_planck_temperature(sensorindex_imager,5,imager_mean(2),imager_mean(2)) ! Channel 16 average BT
imager_std_dev(2) = imager_std_dev(2) - imager_mean(2) ! Channel 16 BT std dev
data_all(maxinfo+23,itx) = imager_std_dev(2)
else
data_all(maxinfo+23,itx) = zero
endif

else ! Imager cluster information is missing. Set everything to zero
data_all(maxinfo+1 : maxinfo+25,itx) = zero
data_all(maxinfo+1 : maxinfo+cads_info,itx) = zero
endif
endif ! cris_cads

Expand Down
8 changes: 5 additions & 3 deletions src/gsi/read_diag.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ module read_diag
! Declare structures for radiance diagnostic file information
type diag_header_fix_list
character(len=20) :: isis ! sat and sensor type
character(len=10) :: id ! sat type
character(len=11) :: id ! sat type
character(len=10) :: obstype ! observation type
integer(i_kind) :: jiter ! outer loop counter
integer(i_kind) :: nchan ! number of channels in the sensor
Expand Down Expand Up @@ -414,7 +414,8 @@ subroutine read_radiag_header_nc(ftin,header_fix,header_chan,iflag)
real(r_kind),allocatable,dimension(:) :: r_var_stor
integer(i_kind),allocatable,dimension(:) :: i_var_stor
character(20) :: isis
character(10) :: id, obstype
character(11) :: id
character(10) :: obstype
! integer(i_kind),dimension(:),allocatable :: jiter, nchan_diag, npred, idate, &
integer(i_kind) :: jiter, nchan_diag, npred, idate, &
ireal, ipchan, iextra, jextra, &
Expand Down Expand Up @@ -515,7 +516,8 @@ subroutine read_radiag_header_bin(ftin,npred_radiag,retrieval,header_fix,header_

! Declare local variables
character(len=2):: string
character(len=10):: satid,sentype
character(len=11):: satid
character(len=10):: sentype
character(len=20):: sensat
integer(i_kind) :: i,ich
integer(i_kind):: jiter,nchanl,npred,ianldate,ireal,ipchan,iextra,jextra
Expand Down
Loading

0 comments on commit de74bb2

Please sign in to comment.