wrfv2_fire/var/da/da_radiance/da_read_simulated_rad.inc

   1 subroutine da_read_simulated_rad (iv)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: Generate simulated radiances for every model grid point and
   5    !           every channel
   6    !
   7    !  Called from
   8    !
   9    !  HISTORY: 12/12/2008 - Creation                        Tom Auligne
  10    !---------------------------------------------------------------------------
  11
  12    use da_control
  13
  14    implicit none
  15
  16    type (iv_type),  intent (inout) :: iv
  17
  18    ! Instrument triplet, follow the convension of RTTOV
  19    integer   :: platform_id, satellite_id, sensor_id
  20
  21    type (datalink_type) :: p
  22
  23    logical :: outside, outside_all
  24    integer :: i,j,k,nchan,inst, alloc_stat
  25    type(info_type)       ::  info
  26    type(model_loc_type)  ::  loc
  27
  28    call da_trace_entry("da_read_simulated_rad")
  29
  30    ! Initialize variables
  31
  32    platform_id  = pseudo_rad_platid
  33    satellite_id = pseudo_rad_satid
  34    sensor_id    = pseudo_rad_senid
  35    if (sensor_id == 0) then
  36       nchan=19 !nchan_hirs
  37    else if (sensor_id == 1) then
  38       nchan=nchan_msu
  39    else if (sensor_id == 3) then
  40       nchan=nchan_amsua
  41    else if (sensor_id == 4)  then
  42       nchan=nchan_amsub
  43    else if (sensor_id == 15)  then
  44       nchan=nchan_mhs
  45    else if (sensor_id == 10)  then
  46       nchan=nchan_ssmis
  47    else if (sensor_id == 11)  then
  48       nchan=nchan_airs
  49    end if
  50
  51    inst = 1    ! single instrument
  52
  53    iv%info(radiance)%ntotal    = (ide - ids + 1) * (jde - jds + 1)
  54    iv%info(radiance)%nlocal    = (min(ipe+simulated_rad_ngrid,ide) - max(ips-simulated_rad_ngrid,ids) + 1) * &
  55                                  (min(jpe+simulated_rad_ngrid,jde) - max(jps-simulated_rad_ngrid,jds) + 1)
  56    iv%info(radiance)%ptotal(1) = iv%info(radiance)%ntotal
  57    iv%instid(inst)%num_rad     = iv%info(radiance)%nlocal
  58    iv%instid(inst)%info%nlocal = iv%info(radiance)%nlocal
  59
  60    !  5.0 allocate innovation radiance structure
  61    !----------------------------------------------------------------
  62
  63    if ( iv%instid(inst)%num_rad > 0 ) then
  64 #ifdef CRTM
  65       if (rtm_option == rtm_option_crtm) then
  66          iv%instid(inst)%nlevels = kme-kms+1
  67          iv%instid(inst)%nchannels=nchan
  68       end if
  69 #endif
  70 #ifdef RTTOV
  71       if (rtm_option == rtm_option_rttov) then
  72          call rttov_setupchan(inst, nchan, coefs(inst), &   ! in
  73             iv%instid(inst)%nfrequencies,iv%instid(inst)%nchannels, &
  74             iv%instid(inst)%nbtout)      ! out
  75       end if
  76 #endif
  77
  78       call da_allocate_rad_iv(inst,nchan,iv)
  79
  80       !  6.0 assign sequential structure to innovation structure
  81       !-------------------------------------------------------------
  82
  83       allocate (p%tb_inv(1:nchan), stat=alloc_stat)
  84       if ( alloc_stat /= 0 ) CALL da_error(__FILE__,__LINE__,(/"error allocating"/))
  85
  86       p%info%date_char   = "0000-00-00_00:00:00"
  87       p%landsea_mask     = 1
  88       p%scanpos          = 1
  89       p%satzen           = 0.0
  90       p%satazi           = 0.0
  91       p%solzen           = 0.0
  92       p%tb_inv(1:nchan)  = pseudo_rad_inv
  93       p%sensor_index     = inst
  94       p%ifgat            = 1
  95
  96       k = 0
  97       do i = ids, ide
  98          do j = jds, jde
  99             if ((i<ips-simulated_rad_ngrid).or.(i>ipe+simulated_rad_ngrid).or. &
 100                 (j<jps-simulated_rad_ngrid).or.(j>jpe+simulated_rad_ngrid)) cycle
 101             k = k + 1
 102             call da_xyll(map_info, i*1.0, j*1.0, p%info%lat, p%info%lon)
 103             p%loc%x   = float(i)
 104             p%loc%y   = float(j)
 105             p%loc%i   = i
 106             p%loc%j   = j
 107             p%loc%dx  = 0.0
 108             p%loc%dxm = 1.0
 109             p%loc%dy  = 0.0
 110             p%loc%dym = 1.0
 111             call da_initialize_rad_iv (inst, k, iv, p)
 112          end do
 113       end do
 114
 115       iv%instid(inst)%tb_error(:,:) = pseudo_rad_err
 116       iv%instid(inst)%tb_qc(:,:)    = qc_good
 117
 118       deallocate(p%tb_inv)
 119    end if
 120
 121       write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') &
 122         'Allocating space for radiance innov structure', &
 123          inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad
 124
 125    call da_trace_exit("da_read_simulated_rad")
 126
 127 end subroutine da_read_simulated_rad