var/da/da_varbc_tamdar/da_varbc_tamdar_direct.inc

   1    subroutine da_varbc_tamdar_direct (iv,ob)
   2
   3    !-----------------------------------------------!
   4    !  Apply bias correction to TAMDAR innovations  !
   5    !-----------------------------------------------!
   6
   7    implicit none
   8
   9    type (iv_type), intent(inout)   :: iv
  10    type (y_type),  intent(inout)   :: ob
  11
  12    real                            :: bc,bias
  13    real                            :: contri(5)
  14    integer                         :: i,isn,iflt,iobs,ipred,iphase,nobs
  15    character(len=3)                :: cphz(3)
  16    character(len=30)               :: stringn
  17
  18
  19    if (trace_use) call da_trace_entry("da_varbc_tamdar_direct")
  20
  21    if (rootproc) &
  22        write(unit=varbc_tamdar_unit,fmt='(//5X,A/)')'Calculating corrected innovation'
  23
  24    cphz = (/'des','asc','cru'/)
  25
  26    do iflt = 1, iv%varbc_tamdar%nair
  27       do iphase = 1, iv%varbc_tamdar%nphase
  28          if (iv%varbc_tamdar%nobs_sum(iphase,iflt) >= varbc_tamdar_nobsmin) then
  29
  30              bc = SUM( iv%varbc_tamdar%param(1:iv%varbc_tamdar%npred,iphase,iflt) * &
  31                        iv%varbc_tamdar%pred(1:iv%varbc_tamdar%npred,iphase,iflt) )
  32
  33              nobs = 0
  34              bias = 0.
  35
  36              if (iv%varbc_tamdar%nobs(iphase,iflt) > 0 .and. iv%varbc_tamdar%ifuse(iphase,iflt) > 0 ) then
  37                  do iobs = 1, iv%varbc_tamdar%nobs(iphase,iflt)
  38                     isn = iv%varbc_tamdar%obs_sn(iobs,iphase,iflt)
  39                     if (iv%tamdar(isn)%t(1)%qc >= 0) then
  40                         bias = bias + iv%tamdar(isn)%t(1)%inv
  41                         nobs = nobs + 1
  42
  43                         iv%tamdar(isn)%t(1)%inv = iv%tamdar(isn)%t(1)%inv - bc
  44                     end if
  45                  end do
  46              end if
  47
  48              if (wrf_dm_sum_integer(nobs) > 0) &
  49                  bias = wrf_dm_sum_real(bias)/wrf_dm_sum_integer(nobs)
  50
  51              if (rootproc .and. iv%varbc_tamdar%ifuse(iphase,iflt) > 0) then
  52                  write(unit=varbc_tamdar_unit,fmt='(10X,A,I5,A,2X,A,2X,A,2F10.4)') &
  53                       'bias corrected for ',iv%varbc_tamdar%tail_id(iflt),  &
  54                       '  at', cphz(iphase), ': (BC,OMB)', bc, bias
  55              end if
  56
  57          end if
  58       end do
  59    end do
  60
  61    if (rootproc) write(unit=varbc_tamdar_unit,fmt='(/10X,A)') &
  62                       " ID  Phase  Predictor/Parameter/Bias model (npred)  &  BC"
  63
  64    ipred = 3*iv%varbc_tamdar%npred+1
  65    write(stringn,'(I3)') ipred
  66    stringn = '(10X,I4,2X,A,2X,'//trim(ADJUSTL(stringn))//'f8.3)'
  67    stringn = trim(adjustl(stringn))
  68
  69    do iflt = 1, iv%varbc_tamdar%nair
  70       do iphase = 1, iv%varbc_tamdar%nphase
  71          if (rootproc .and. iv%varbc_tamdar%ifuse(iphase,iflt) > 0) then
  72
  73              contri(:) = 0.
  74              bc = 0.
  75
  76              do ipred = 1, iv%varbc_tamdar%npred
  77                 contri(ipred) = &
  78                        iv%varbc_tamdar%param(ipred,iphase,iflt) * &
  79                        iv%varbc_tamdar%pred(ipred,iphase,iflt)
  80                 bc = bc + contri(ipred)
  81              end do
  82
  83              write(unit=varbc_tamdar_unit,fmt=stringn) &
  84                    iv%varbc_tamdar%tail_id(iflt), cphz(iphase), &
  85                   (iv%varbc_tamdar%pred(ipred,iphase,iflt), &
  86                    iv%varbc_tamdar%param(ipred,iphase,iflt), &
  87                    contri(ipred), ipred=1,iv%varbc_tamdar%npred),bc
  88          end if
  89       end do
  90    end do
  91
  92    if (trace_use) call da_trace_exit("da_varbc_tamdar_direct")
  93
  94    end subroutine da_varbc_tamdar_direct