var/da/da_statistics/da_print_qcstat.inc

   1 subroutine da_print_qcstat(it, iv, num_qcstat_conv)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (iv_type), intent(inout) :: iv      ! innovation vector.
  10    integer,           intent(in) :: it
  11    integer,        intent(inout) ::  num_qcstat_conv(:,:,:,:)
  12
  13    integer                       :: ii, i, j, k ,n, num, ounit, ios
  14    character(len=filename_len)   :: file
  15    character*4 :: ob_field      ! Added by Soyoung (Aug-2021)
  16
  17    logical   :: write_head
  18    character(1),dimension(115):: cline
  19    character(4),dimension(2):: typx
  20    integer,  allocatable :: count(:)
  21 !
  22    if (trace_use) call da_trace_entry("da_print_qcstat")
  23    num = num_ob_indexes*num_ob_vars*(npres_print)
  24    allocate (count(2*num))
  25
  26   do k=1,115
  27      cline(k) = '-'
  28   end do
  29   typx(1)='used'
  30   typx(2)='rej '
  31     count  = 0
  32     ii = 0
  33         do k = 1, npres_print
  34         do j = 1, num_ob_vars
  35         do i = 1, num_ob_indexes
  36           ii = ii + 1
  37            count(ii)     = num_qcstat_conv(1,i,j,k)
  38            count(num+ii) = num_qcstat_conv(2,i,j,k)
  39         end do
  40         end do
  41         end do
  42
  43     call da_proc_sum_ints(count)
  44
  45   if (rootproc) then
  46       call da_get_unit(ounit)
  47       write(unit=file,fmt ='(a,i2.2)')'qcstat_conv_',it
  48       open(unit=ounit,file=trim(file),form='formatted', status='replace', iostat=ios)
  49       if (ios /= 0) call da_error(__FILE__,__LINE__, &
  50          (/"Cannot open file "//file/))
  51     num_qcstat_conv = 0
  52     ii = 0
  53         do k = 1, npres_print
  54         do j = 1, num_ob_vars
  55         do i = 1, num_ob_indexes
  56           ii = ii + 1
  57           num_qcstat_conv(1,i,j,k) = count(ii)
  58           num_qcstat_conv(2,i,j,k) = count(num+ii)
  59         end do
  60         end do
  61         end do
  62
  63         do j = 1, num_ob_vars
  64         do i = 1, num_ob_indexes
  65          num_qcstat_conv(1,i,j,npres_print+1) = sum( num_qcstat_conv(1,i,j,1:npres_print) )
  66          num_qcstat_conv(2,i,j,npres_print+1) = sum( num_qcstat_conv(2,i,j,1:npres_print) )
  67         end do
  68         end do
  69       write_head = .false.
  70    do i = 1, num_ob_indexes
  71      if (.not. write_head) then
  72 51   format(110a1)
  73      write(ounit,50)it
  74 50   format(20x,'WRF-Var data utilization statistics for outer iteration ',i3,/)
  75      write(ounit,510)'ptop',(pptop(k),k=1,npres_print), 0.0
  76      write(ounit,511)'obs type','var','pbot',(ppbot(k),k=1,npres_print), 2000.0
  77 510  format(15x,a8,1x,13(1x,f6.1))
  78 511  format(1x,a8,1x,a3,6x,a4,1x,13(1x,f6.1))
  79      write(ounit,500) (cline(j),j=1,115)
  80 500  format(115a1)
  81      write_head = .true.
  82      end if
  83     do j = 1, num_ob_vars
  84      ob_field = ob_vars(j)      ! Added by Soyoung (Aug-2021)
  85 #if (WRF_CHEM == 1)
  86      if (i.eq.num_ob_indexes) ob_field = 'chem'
  87 #endif
  88      if( num_qcstat_conv(1,i,j,npres_print+1) > 0 )  then
  89       write(ounit,700) obs_names(i),ob_field,typx(1),&       ! Soyoung (Aug-2021)
  90 !      write(ounit,700) obs_names(i),ob_vars(j),typx(1),&
  91       ((num_qcstat_conv(1,i,j,k) - num_qcstat_conv(2,i,j,k)),k=1,npres_print+1)
  92       write(ounit,701) typx(2), (num_qcstat_conv(2,i,j,k),k=1,npres_print+1)
  93 700 format(1x,a12,a4,2x,a4,1x, 25(1x,i6) )
  94 701 format(19x,a4,1x,25(1x,i6) )
  95      end if
  96     end do
  97    end do
  98     write(ounit,500) (cline(j),j=1,115)
  99   close (ounit)
 100   call da_free_unit(ounit)
 101   end if
 102
 103    deallocate (count)
 104    if (trace_use) call da_trace_exit("da_print_qcstat")
 105
 106 end subroutine da_print_qcstat