var/da/da_sound/da_obs_diagnostics.inc

   1 subroutine da_obs_diagnostics(num_sound, ob, iv, re)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    integer,                    intent(in) :: num_sound
  10    type (residual_sound_type), intent(in) :: ob(:)
  11    type (sound_type),          intent(in) :: iv(:)
  12    type (residual_sound_type), intent(in) :: re(:)
  13
  14    integer :: n, k
  15    integer :: sound_diag_unit1
  16    integer :: sound_diag_unit2
  17    integer :: sound_diag_unit3
  18    integer :: sound_diag_unit4
  19
  20    if (trace_use) call da_trace_entry("da_obs_diagnostics")
  21
  22    call da_get_unit(sound_diag_unit1)
  23    call da_get_unit(sound_diag_unit2)
  24    call da_get_unit(sound_diag_unit3)
  25    call da_get_unit(sound_diag_unit4)
  26    open(unit=sound_diag_unit1,file="sound_diag1",status="replace")
  27    open(unit=sound_diag_unit2,file="sound_diag2",status="replace")
  28    open(unit=sound_diag_unit3,file="sound_diag3",status="replace")
  29    open(unit=sound_diag_unit4,file="sound_diag4",status="replace")
  30
  31    do n = 1, num_sound
  32       do k = 1, iv(n) % info % levels
  33          if (iv(n) % u(k) % qc >= obs_qc_pointer) then
  34             write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
  35                iv(n) % info % id, &   ! Station
  36                iv(n) % info % lat, &  ! Latitude
  37                iv(n) % info % lon, &  ! Longitude
  38                iv(n) % p(k), &        ! Obs Pressure
  39                ob(n) % u(k), &        ! O
  40                iv(n) % u(k) % inv, &  ! O-B
  41                re(n) % u(k), &        ! O-A
  42                iv(n) % u(k) % error, &! Obs error
  43                iv(n) % u(k) % qc      ! QC flag
  44          end if
  45
  46          if (iv(n) % v(k) % qc >= obs_qc_pointer) then
  47             write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
  48                iv(n) % info % id, & ! Station
  49                iv(n) % info % lat, &  ! Latitude
  50                iv(n) % info % lon, &  ! Longitude
  51                iv(n) % h(k), &        ! Obs Pressure
  52                ob(n) % v(k), &        ! O
  53                iv(n) % v(k) % inv, &  ! O-B
  54                re(n) % v(k), &        ! O-A
  55                iv(n) % v(k) % error, &! Obs error
  56                iv(n) % v(k) % qc      ! QC flag
  57          end if
  58
  59          if (iv(n) % t(k) % qc >= obs_qc_pointer) then
  60             write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
  61                iv(n) % info % id, & ! Station
  62                iv(n) % info % lat, &  ! Latitude
  63                iv(n) % info % lon, &  ! Longitude
  64                iv(n) % h(k), &        ! Obs Pressure
  65                ob(n) % t(k), &        ! O
  66                iv(n) % t(k) % inv, &  ! O-B
  67                re(n) % t(k), &        ! O-A
  68                iv(n) % t(k) % error, &! Obs error
  69                iv(n) % t(k) % qc      ! QC flag
  70          end if
  71
  72          if (iv(n) % q(k) % qc >= obs_qc_pointer) then
  73             write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
  74                iv(n) % info % id, & ! Station
  75                iv(n) % info % lat, &  ! Latitude
  76                iv(n) % info % lon, &  ! Longitude
  77                iv(n) % h(k), &        ! Obs Pressure
  78                ob(n) % q(k), &        ! O
  79                iv(n) % q(k) % inv, &  ! O-B (kg/kg)
  80                re(n) % q(k), &        ! O-A
  81                iv(n) % q(k) % error, &! Obs error (kg/kg)
  82                iv(n) % q(k) % qc      ! QC flag
  83          end if
  84       end do
  85    end do
  86
  87    !  End of file markers:
  88    write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
  89      '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
  90
  91    write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
  92      '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
  93
  94    write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
  95      '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
  96
  97    write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
  98       '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
  99
 100    close(sound_diag_unit1)
 101    close(sound_diag_unit2)
 102    close(sound_diag_unit3)
 103    close(sound_diag_unit4)
 104    call da_free_unit(sound_diag_unit1)
 105    call da_free_unit(sound_diag_unit2)
 106    call da_free_unit(sound_diag_unit3)
 107    call da_free_unit(sound_diag_unit4)
 108
 109    if (trace_use) call da_trace_exit("da_obs_diagnostics")
 110
 111  end subroutine da_obs_diagnostics
 112
 113