Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Format changes #773

Merged
merged 7 commits into from
Jul 31, 2024
Merged

Format changes #773

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
237d93c
These are format changes in preparation for metop-sg-a1. The satelli…
wx20jjung Jul 5, 2024
49663ce
Merge branch 'NOAA-EMC:develop' into format_changes
wx20jjung Jul 5, 2024
1bcda33
Merge branch 'NOAA-EMC:develop' into format_changes
wx20jjung Jul 10, 2024
212e012
Fixed a missed character length.
wx20jjung Jul 10, 2024
0db28da
Merge branch 'format_changes' of https://github.com/wx20jjung/GSI int…
wx20jjung Jul 10, 2024
58246e8
These changes restructure the imager information for CrIS (VIIRS) and…
wx20jjung Jul 25, 2024
4ba610b
Merge branch 'NOAA-EMC:develop' into format_changes
wx20jjung Jul 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/gsi/gsimod.F90
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Loading