var/da/da_radiance/da_initialize_rad_iv.inc

   1 subroutine da_initialize_rad_iv (i, n, iv, p)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: allocate radiance innovation structure
   5    !---------------------------------------------------------------------------
   6
   7    use da_control
   8
   9    implicit none
  10
  11    integer,             intent(in)    :: i, n
  12    type(datalink_type), intent(in)    :: p
  13    type(iv_type),       intent(inout) :: iv
  14    integer                            :: ix, iy
  15
  16    call da_trace_entry("da_initialize_rad_iv")
  17
  18    iv%instid(i)%info%lat(:,n)   = p%info%lat
  19    iv%instid(i)%info%lon(:,n)   = p%info%lon
  20    iv%instid(i)%info%elv(n)     = p%info%elv
  21    iv%instid(i)%info%date_char(n) = p%info%date_char
  22
  23    iv%instid(i)%info%max_lev    = iv%instid(i)%nlevels
  24    iv%instid(i)%info%levels(n)  = iv%instid(i)%nlevels
  25    iv%instid(i)%info%i  (:,n)   = p%loc%i
  26    iv%instid(i)%info%j  (:,n)   = p%loc%j
  27    iv%instid(i)%info%k  (:,n)   = 0
  28    iv%instid(i)%info%dx (:,n)   = p%loc%dx
  29    iv%instid(i)%info%dy (:,n)   = p%loc%dy
  30    iv%instid(i)%info%dz (:,n)   = 0.0
  31    iv%instid(i)%info%dxm(:,n)   = p%loc%dxm
  32    iv%instid(i)%info%dym(:,n)   = p%loc%dym
  33    iv%instid(i)%info%dzm(:,n)   = 0.0
  34    iv%instid(i)%info%proc_domain(:,n) = .false.
  35    ! z done in da_get_innov_vector_rad
  36    iv%instid(i)%t(:,n)          = 0.0
  37    iv%instid(i)%mr(:,n)         = 0.0
  38    iv%instid(i)%tm(:,n)         = 0.0
  39    iv%instid(i)%qm(:,n)         = 0.0
  40    iv%instid(i)%qrn(:,n)        = 0.0
  41    iv%instid(i)%qcw(:,n)        = 0.0
  42    if ( crtm_cloud ) then
  43       iv%instid(i)%qci(:,n)        = 0.0
  44       iv%instid(i)%qsn(:,n)        = 0.0
  45       iv%instid(i)%qgr(:,n)        = 0.0
  46       iv%instid(i)%qhl(:,n)        = 0.0
  47       iv%instid(i)%rcw(:,n)        = 0.0
  48       iv%instid(i)%rci(:,n)        = 0.0
  49       iv%instid(i)%rrn(:,n)        = 0.0
  50       iv%instid(i)%rsn(:,n)        = 0.0
  51       iv%instid(i)%rgr(:,n)        = 0.0
  52       iv%instid(i)%rhl(:,n)        = 0.0
  53    end if
  54    iv%instid(i)%pm(:,n)         = 0.0
  55    iv%instid(i)%pf(:,n)         = 0.0
  56    iv%instid(i)%u10(n)          = 0.0
  57    iv%instid(i)%v10(n)          = 0.0
  58    iv%instid(i)%t2m(n)          = 0.0
  59    iv%instid(i)%q2m(n)          = 0.0
  60    iv%instid(i)%mr2m(n)         = 0.0
  61    iv%instid(i)%psfc(n)         = 0.0
  62    iv%instid(i)%ts(n)           = 0.0
  63    iv%instid(i)%smois(n)        = 0.0
  64    iv%instid(i)%tslb(n)         = 0.0
  65    iv%instid(i)%snowh(n)        = 0.0
  66    iv%instid(i)%isflg(n)        = 0
  67    iv%instid(i)%soiltyp(n)      = 0.0
  68    iv%instid(i)%landsea_mask(n) = p%landsea_mask
  69    iv%instid(i)%elevation(n)    = 0.0
  70    iv%instid(i)%vegfra(n)       = 0.0
  71    iv%instid(i)%vegtyp(n)       = 0.0
  72    iv%instid(i)%clwp(n)         = 0.0
  73    if ( index(iv%instid(i)%rttovid_string, 'amsr2') > 0 ) then
  74       iv%instid(i)%clw(n)       = p%clw
  75    end if
  76    if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then
  77       iv%instid(i)%cloudflag(n) = p%cloudflag
  78    end if
  79    iv%instid(i)%cloud_flag(:,n) = qc_good  ! no cloud
  80    if ( index(iv%instid(i)%rttovid_string, 'gmi') > 0 ) then
  81       iv%instid(i)%clw(n)       = p%clw
  82    end if
  83    iv%instid(i)%ps(n)           = 0.0
  84    iv%instid(i)%tb_xb(:,n)      = 0.0
  85    if ( crtm_cloud ) then
  86       iv%instid(i)%tb_xb_clr(:,n) = 0.0
  87       iv%instid(i)%cip(n)         = 0.0
  88    end if
  89    iv%instid(i)%tb_inv(:,n)     = p%tb_inv(:)
  90    iv%instid(i)%tb_qc(:,n)      = 0
  91    iv%instid(i)%tb_error(:,n)   = 500.0
  92    iv%instid(i)%tb_sens(:,n)    = 0.0
  93    iv%instid(i)%tb_imp(:,n)     = 0.0
  94    iv%instid(i)%rad_xb(:,n)     = 0.0
  95    iv%instid(i)%rad_obs(:,n)    = 0.0
  96    iv%instid(i)%rad_ovc(:,:,n)  = 0.0
  97    iv%instid(i)%emiss(:,n)      = 0.0
  98    iv%instid(i)%scanpos(n)      = p%scanpos
  99    ! iv%instid(i)%scanline(n)    = p%scanline
 100    iv%instid(i)%scanline(n)     = 0
 101    iv%instid(i)%ifgat(n)        = p%ifgat
 102    iv%instid(i)%cloud_flag(:,n) = qc_good  ! no cloud
 103    iv%instid(i)%rain_flag(n)    = 0        ! no rain;  1:rain
 104    iv%instid(i)%satzen(n)       = p%satzen
 105    iv%instid(i)%satazi(n)       = p%satazi
 106    iv%instid(i)%solzen(n)       = p%solzen
 107    iv%instid(i)%solazi(n)       = p%solazi
 108    iv%instid(i)%tropt(n)        = 0.0
 109    iv%instid(i)%cloud_frac(n)   = missing_r
 110  !  iv%instid(i)%solazi(n)       = 0.0
 111    if ( use_clddet_zz ) then
 112       if ( allocated ( p % superob ) ) then
 113          do iy = 1, iv%instid(i)%superob_width
 114          do ix = 1, iv%instid(i)%superob_width
 115             iv%instid(i)%superob(ix,iy)%tb_obs(:,n) = p % superob(ix,iy) % tb_obs(:,1)
 116             iv%instid(i)%superob(ix,iy)%cld_qc(n)%RTCT = p % superob(ix,iy) % cld_qc(1) % RTCT
 117             iv%instid(i)%superob(ix,iy)%cld_qc(n)%RFMFT = p % superob(ix,iy) % cld_qc(1) % RFMFT
 118             iv%instid(i)%superob(ix,iy)%cld_qc(n)%TEMPIR = p % superob(ix,iy) % cld_qc(1) % TEMPIR
 119             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_10 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_10
 120             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_13 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_13
 121             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_14 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_14
 122             iv%instid(i)%superob(ix,iy)%cld_qc(n)%terr_hgt = p % superob(ix,iy) % cld_qc(1) % terr_hgt
 123             iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O = p % superob(ix,iy) % cld_qc(1) % CIRH2O
 124          end do
 125          end do
 126       end if
 127    end if
 128    if ( rtm_option == rtm_option_rttov ) then
 129       iv%instid(i)%surftype(n)     = 0
 130       iv%instid(i)%snow_frac(n)     = 0.0
 131    end if
 132
 133    iv%instid(i)%gamma_jacobian(:,n)=0.0
 134
 135    if ( use_rttov_kmatrix .or. use_crtm_kmatrix ) then
 136       iv%instid(i)%ts_jacobian(:,n)=0.0
 137       iv%instid(i)%ps_jacobian(:,n)=0.0
 138       iv%instid(i)%emiss_jacobian(:,n)=0.0
 139       iv%instid(i)%windspeed_jacobian(:,n)=0.0
 140       iv%instid(i)%t_jacobian(:,:,n)=0.0
 141       iv%instid(i)%q_jacobian(:,:,n)=0.0
 142    end if
 143
 144    if (rtm_option == rtm_option_crtm) then
 145       iv%instid(i)%crtm_climat(n)=0  ! invalid_model
 146       iv%instid(i)%water_coverage(n)=1.0
 147       iv%instid(i)%land_coverage(n)=0.0
 148       iv%instid(i)%ice_coverage(n)=0.0
 149       iv%instid(i)%snow_coverage(n)=0.0
 150       if (use_crtm_kmatrix) then
 151          if ( crtm_cloud ) then
 152             iv%instid(i)%water_jacobian(:,:,n)=0.0
 153             iv%instid(i)%ice_jacobian(:,:,n)=0.0
 154             iv%instid(i)%rain_jacobian(:,:,n)=0.0
 155             iv%instid(i)%snow_jacobian(:,:,n)=0.0
 156             iv%instid(i)%graupel_jacobian(:,:,n)=0.0
 157             iv%instid(i)%hail_jacobian(:,:,n)=0.0
 158             iv%instid(i)%water_r_jacobian(:,:,n)=0.0
 159             iv%instid(i)%ice_r_jacobian(:,:,n)=0.0
 160             iv%instid(i)%rain_r_jacobian(:,:,n)=0.0
 161             iv%instid(i)%snow_r_jacobian(:,:,n)=0.0
 162             iv%instid(i)%graupel_r_jacobian(:,:,n)=0.0
 163             iv%instid(i)%hail_r_jacobian(:,:,n)=0.0
 164          end if
 165          if ( calc_weightfunc ) then
 166             iv%instid(i)%lod(:,:,n) = 0.0
 167             iv%instid(i)%lod_jacobian(:,:,n) = 0.0
 168             iv%instid(i)%trans(:,:,n) = 0.0
 169             iv%instid(i)%trans_jacobian(:,:,n) = 0.0
 170             iv%instid(i)%der_trans(:,:,n) = 0.0
 171          end if
 172
 173          if (use_clddet==3) then
 174             iv%instid(i)%kmin_t(n) = 0.0
 175             iv%instid(i)%kmax_p(n) = 0.0
 176             iv%instid(i)%sensitivity_ratio(:,:,n) = 0.0
 177             iv%instid(i)%p_chan_level(:,n) = 0.0
 178          end if
 179
 180       end if
 181    end if
 182
 183    call da_trace_exit("da_initialize_rad_iv")
 184
 185 end subroutine da_initialize_rad_iv
 186