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    !if ( associated( p % rad_obs ) ) then
  97    !   iv%instid(i)%rad_obs(:,n) = p%rad_obs(:)
  98    !else
  99    !   iv%instid(i)%rad_obs(:,n) = 0.0
 100    !end if
 101    iv%instid(i)%rad_ovc(:,:,n)  = 0.0
 102    iv%instid(i)%emiss(:,n)      = 0.0
 103    iv%instid(i)%scanpos(n)      = p%scanpos
 104    ! iv%instid(i)%scanline(n)    = p%scanline
 105    iv%instid(i)%scanline(n)     = 0
 106    iv%instid(i)%ifgat(n)        = p%ifgat
 107    iv%instid(i)%cloud_flag(:,n) = qc_good  ! no cloud
 108    iv%instid(i)%rain_flag(n)    = 0        ! no rain;  1:rain
 109    iv%instid(i)%satzen(n)       = p%satzen
 110    iv%instid(i)%satazi(n)       = p%satazi
 111    iv%instid(i)%solzen(n)       = p%solzen
 112    iv%instid(i)%solazi(n)       = p%solazi
 113    iv%instid(i)%tropt(n)        = 0.0
 114    iv%instid(i)%cloud_frac(n)   = missing_r
 115  !  iv%instid(i)%solazi(n)       = 0.0
 116    if ( use_clddet_zz ) then
 117       if ( allocated ( p % superob ) ) then
 118          do iy = 1, iv%instid(i)%superob_width
 119          do ix = 1, iv%instid(i)%superob_width
 120             iv%instid(i)%superob(ix,iy)%tb_obs(:,n) = p % superob(ix,iy) % tb_obs(:,1)
 121            if (index(iv%instid(i)%rttovid_string, 'abi') > 0) then
 122             if ( allocated ( p % superob(ix,iy) % cld_qc(1) % tb_stddev_3x3 ) ) &
 123                iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3(:) = p % superob(ix,iy) % cld_qc(1) % tb_stddev_3x3(:)
 124            end if
 125            if (index(iv%instid(i)%rttovid_string, 'ahi') > 0) then
 126             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_10 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_10
 127             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_13 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_13
 128             iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_14 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_14
 129            end if
 130             iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O = p % superob(ix,iy) % cld_qc(1) % CIRH2O
 131             iv%instid(i)%superob(ix,iy)%cld_qc(n)%RTCT = p % superob(ix,iy) % cld_qc(1) % RTCT
 132             iv%instid(i)%superob(ix,iy)%cld_qc(n)%RFMFT = p % superob(ix,iy) % cld_qc(1) % RFMFT
 133             iv%instid(i)%superob(ix,iy)%cld_qc(n)%TEMPIR = p % superob(ix,iy) % cld_qc(1) % TEMPIR
 134             iv%instid(i)%superob(ix,iy)%cld_qc(n)%terr_hgt = p % superob(ix,iy) % cld_qc(1) % terr_hgt
 135          end do
 136          end do
 137       end if
 138    end if
 139    if ( rtm_option == rtm_option_rttov ) then
 140       iv%instid(i)%surftype(n)     = 0
 141       iv%instid(i)%snow_frac(n)     = 0.0
 142    end if
 143
 144    iv%instid(i)%gamma_jacobian(:,n)=0.0
 145
 146    if ( use_rttov_kmatrix .or. use_crtm_kmatrix ) then
 147       iv%instid(i)%ts_jacobian(:,n)=0.0
 148       iv%instid(i)%ps_jacobian(:,n)=0.0
 149       iv%instid(i)%emiss_jacobian(:,n)=0.0
 150       iv%instid(i)%windspeed_jacobian(:,n)=0.0
 151       iv%instid(i)%t_jacobian(:,:,n)=0.0
 152       iv%instid(i)%q_jacobian(:,:,n)=0.0
 153    end if
 154
 155    if (rtm_option == rtm_option_crtm) then
 156       iv%instid(i)%crtm_climat(n)=0  ! invalid_model
 157       iv%instid(i)%water_coverage(n)=1.0
 158       iv%instid(i)%land_coverage(n)=0.0
 159       iv%instid(i)%ice_coverage(n)=0.0
 160       iv%instid(i)%snow_coverage(n)=0.0
 161       if (use_crtm_kmatrix) then
 162          if ( crtm_cloud ) then
 163             iv%instid(i)%water_jacobian(:,:,n)=0.0
 164             iv%instid(i)%ice_jacobian(:,:,n)=0.0
 165             iv%instid(i)%rain_jacobian(:,:,n)=0.0
 166             iv%instid(i)%snow_jacobian(:,:,n)=0.0
 167             iv%instid(i)%graupel_jacobian(:,:,n)=0.0
 168             iv%instid(i)%hail_jacobian(:,:,n)=0.0
 169             iv%instid(i)%water_r_jacobian(:,:,n)=0.0
 170             iv%instid(i)%ice_r_jacobian(:,:,n)=0.0
 171             iv%instid(i)%rain_r_jacobian(:,:,n)=0.0
 172             iv%instid(i)%snow_r_jacobian(:,:,n)=0.0
 173             iv%instid(i)%graupel_r_jacobian(:,:,n)=0.0
 174             iv%instid(i)%hail_r_jacobian(:,:,n)=0.0
 175          end if
 176          if ( calc_weightfunc ) then
 177             iv%instid(i)%lod(:,:,n) = 0.0
 178             iv%instid(i)%lod_jacobian(:,:,n) = 0.0
 179             iv%instid(i)%trans(:,:,n) = 0.0
 180             iv%instid(i)%trans_jacobian(:,:,n) = 0.0
 181             iv%instid(i)%der_trans(:,:,n) = 0.0
 182          end if
 183
 184          if (use_clddet==3) then
 185             iv%instid(i)%kmin_t(n) = 0.0
 186             iv%instid(i)%kmax_p(n) = 0.0
 187             iv%instid(i)%sensitivity_ratio(:,:,n) = 0.0
 188             iv%instid(i)%p_chan_level(:,n) = 0.0
 189          end if
 190
 191       end if
 192    end if
 193
 194    call da_trace_exit("da_initialize_rad_iv")
 195
 196 end subroutine da_initialize_rad_iv
 197