<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_OBS_DIAGNOSTICS'><A href='../../html_code/sound/da_obs_diagnostics.inc.html#DA_OBS_DIAGNOSTICS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_obs_diagnostics(num_sound, ob, iv, re),10
!-----------------------------------------------------------------------
! Purpose: TBD
!-----------------------------------------------------------------------
implicit none
integer, intent(in) :: num_sound
type (residual_sound_type), intent(in) :: ob(:)
type (sound_type), intent(in) :: iv(:)
type (residual_sound_type), intent(in) :: re(:)
integer :: n, k
integer :: sound_diag_unit1
integer :: sound_diag_unit2
integer :: sound_diag_unit3
integer :: sound_diag_unit4
if (trace_use) call da_trace_entry
("da_obs_diagnostics")
call da_get_unit(sound_diag_unit1)
call da_get_unit(sound_diag_unit2)
call da_get_unit(sound_diag_unit3)
call da_get_unit(sound_diag_unit4)
open(unit=sound_diag_unit1,file="sound_diag1",status="replace")
open(unit=sound_diag_unit2,file="sound_diag2",status="replace")
open(unit=sound_diag_unit3,file="sound_diag3",status="replace")
open(unit=sound_diag_unit4,file="sound_diag4",status="replace")
do n = 1, num_sound
do k = 1, iv(n) % info % levels
if (iv(n) % u(k) % qc >= obs_qc_pointer) then
write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
iv(n) % info % id, & ! Station
iv(n) % info % lat, & ! Latitude
iv(n) % info % lon, & ! Longitude
iv(n) % p(k), & ! Obs Pressure
ob(n) % u(k), & ! O
iv(n) % u(k) % inv, & ! O-B
re(n) % u(k), & ! O-A
iv(n) % u(k) % error, &! Obs error
iv(n) % u(k) % qc ! QC flag
end if
if (iv(n) % v(k) % qc >= obs_qc_pointer) then
write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
iv(n) % info % id, & ! Station
iv(n) % info % lat, & ! Latitude
iv(n) % info % lon, & ! Longitude
iv(n) % h(k), & ! Obs Pressure
ob(n) % v(k), & ! O
iv(n) % v(k) % inv, & ! O-B
re(n) % v(k), & ! O-A
iv(n) % v(k) % error, &! Obs error
iv(n) % v(k) % qc ! QC flag
end if
if (iv(n) % t(k) % qc >= obs_qc_pointer) then
write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
iv(n) % info % id, & ! Station
iv(n) % info % lat, & ! Latitude
iv(n) % info % lon, & ! Longitude
iv(n) % h(k), & ! Obs Pressure
ob(n) % t(k), & ! O
iv(n) % t(k) % inv, & ! O-B
re(n) % t(k), & ! O-A
iv(n) % t(k) % error, &! Obs error
iv(n) % t(k) % qc ! QC flag
end if
if (iv(n) % q(k) % qc >= obs_qc_pointer) then
write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
iv(n) % info % id, & ! Station
iv(n) % info % lat, & ! Latitude
iv(n) % info % lon, & ! Longitude
iv(n) % h(k), & ! Obs Pressure
ob(n) % q(k), & ! O
iv(n) % q(k) % inv, & ! O-B (kg/kg)
re(n) % q(k), & ! O-A
iv(n) % q(k) % error, &! Obs error (kg/kg)
iv(n) % q(k) % qc ! QC flag
end if
end do
end do
! End of file markers:
write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
'00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
'00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
'00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
'00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
close(sound_diag_unit1)
close(sound_diag_unit2)
close(sound_diag_unit3)
close(sound_diag_unit4)
call da_free_unit(sound_diag_unit1)
call da_free_unit(sound_diag_unit2)
call da_free_unit(sound_diag_unit3)
call da_free_unit(sound_diag_unit4)
if (trace_use) call da_trace_exit("da_obs_diagnostics")
end subroutine da_obs_diagnostics