wrfv2_fire/var/da/da_radiance/da_setup_radiance_structures.inc

   1 subroutine da_setup_radiance_structures( grid, ob, iv )
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Define, allocate and read of tovs raidance observation structure.
   5    !---------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (domain) , intent(inout)   :: grid       ! model data
  10    type ( y_type), intent(inout)   :: ob         ! Observation structure.
  11    type (iv_type), intent(inout)   :: iv         ! O-B structure.
  12
  13    character(len=200)          :: filename
  14    integer                     :: i, j, n, ios
  15    logical                     :: lprinttovs
  16
  17    ! thinning variables
  18    integer  :: istart,iend,jstart,jend
  19    real     :: rlonlat(4)
  20    ! crtm_cloud
  21    integer  :: n1,n2,k,its,ite,jts,jte,kts,kte,inst
  22
  23    if (trace_use) call da_trace_entry("da_setup_radiance_structures")
  24
  25    !-------------------------------------------------------------------
  26    ! [1.0] Initialize RTTOV coefs and innovations vector for radiance
  27    !-------------------------------------------------------------------
  28
  29     call da_radiance_init(iv, ob)
  30
  31     do n = 1, rtminit_nsensor
  32        iv%instid(n)%rad_monitoring = rad_monitoring(n)
  33     enddo
  34
  35    !-------------------------------
  36    ! 1.1 Make thinning grids
  37    !------------------------------
  38    call init_constants_derived
  39
  40    if (thinning) then
  41       rlat_min =  r999
  42       rlat_max = -r999
  43       rlon_min =  r999
  44       rlon_max = -r999
  45
  46       istart=MINVAL( grid%i_start(1:grid%num_tiles) )
  47       iend  =MAXVAL( grid%i_end  (1:grid%num_tiles) )
  48       jstart=MINVAL( grid%j_start(1:grid%num_tiles) )
  49       jend  =MAXVAL( grid%j_end  (1:grid%num_tiles) )
  50
  51       do i = istart, iend
  52          do j = jstart, jend
  53             rlat_min=min(rlat_min, grid%xb%lat(i,j))
  54             rlat_max=max(rlat_max, grid%xb%lat(i,j))
  55             if( grid%xb%lon(i,j) < zero) then
  56               rlon_min=min(rlon_min, (r360+grid%xb%lon(i,j)))
  57               rlon_max=max(rlon_max, (r360+grid%xb%lon(i,j)))
  58             else
  59               rlon_min=min(rlon_min, grid%xb%lon(i,j))
  60               rlon_max=max(rlon_max, grid%xb%lon(i,j))
  61             endif
  62          enddo
  63       enddo
  64
  65 #ifdef DM_PARALLEL
  66       call mpi_reduce(rlat_min, rlonlat(1), 1, true_mpi_real, mpi_min, root, comm, ierr)
  67       call mpi_reduce(rlon_min, rlonlat(2), 1, true_mpi_real, mpi_min, root, comm, ierr)
  68       call mpi_reduce(rlat_max, rlonlat(3), 1, true_mpi_real, mpi_max, root, comm, ierr)
  69       call mpi_reduce(rlon_max, rlonlat(4), 1, true_mpi_real, mpi_max, root, comm, ierr)
  70
  71       CALL mpi_bcast( rlonlat, 4 , true_mpi_real , root , comm, ierr )
  72
  73       rlat_min = rlonlat(1)
  74       rlon_min = rlonlat(2)
  75       rlat_max = rlonlat(3)
  76       rlon_max = rlonlat(4)
  77 #endif
  78
  79       dlat_grid = rlat_max - rlat_min
  80       dlon_grid = rlon_max - rlon_min
  81
  82       allocate(thinning_grid(iv%num_inst))
  83       do n=1,iv%num_inst
  84           call makegrids (n,thinning_mesh(n))
  85       end do
  86    end if
  87
  88    !-------------------------------------------------------------------
  89    ! [2.0] Read NCEP bufr tovs data in radiance innovations vector
  90    !-------------------------------------------------------------------
  91
  92    if ( (.not. use_filtered_rad) .and. (.not. use_pseudo_rad) .and. (.not. use_simulated_rad) ) then
  93
  94       if (use_hirs2obs) then
  95          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs2.bufr'
  96          filename = ' '
  97          write(filename(1:10), fmt='(a)') 'hirs2.bufr'
  98          call da_read_obs_bufrtovs ('hirs2', iv, filename)
  99       end if
 100
 101       if (use_msuobs) then
 102          filename = ' '
 103          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from msu.bufr'
 104          write(filename(1:8), fmt='(a)') 'msu.bufr'
 105          call da_read_obs_bufrtovs ('msu  ', iv, filename)
 106       end if
 107
 108       if (use_hirs3obs) then
 109          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs3.bufr'
 110          filename = ' '
 111          write(filename(1:10), fmt='(a)') 'hirs3.bufr'
 112          call da_read_obs_bufrtovs('hirs3', iv, filename)
 113       end if
 114
 115       if (use_amsuaobs) then
 116          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsua.bufr'
 117          filename = ' '
 118          write(filename(1:10), fmt='(a)') 'amsua.bufr'
 119          call da_read_obs_bufrtovs ('amsua', iv, filename)
 120       end if
 121
 122       if (use_amsubobs) then
 123          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsub.bufr'
 124          filename = ' '
 125          write(filename(1:10), fmt='(a)') 'amsub.bufr'
 126          call da_read_obs_bufrtovs ('amsub', iv, filename)
 127       end if
 128
 129       if (use_hirs4obs) then
 130          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs4.bufr'
 131          filename = ' '
 132          write(filename(1:10), fmt='(a)') 'hirs4.bufr'
 133          call da_read_obs_bufrtovs('hirs4', iv, filename)
 134       end if
 135
 136       if (use_mhsobs) then
 137          write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from mhs.bufr'
 138          filename = ' '
 139          write(filename(1:8), fmt='(a)') 'mhs.bufr'
 140          call da_read_obs_bufrtovs('mhs  ', iv, filename)
 141       end if
 142
 143       if (use_airsobs) then
 144          write(unit=stdout,fmt='(a)') 'Reading airs 1b data from airs.bufr'
 145          filename = ' '
 146          write(filename(1:9), fmt='(a)') 'airs.bufr'
 147          call da_read_obs_bufrairs ('airs     ',iv, filename)
 148       end if
 149
 150       if (use_eos_amsuaobs) then
 151          write(unit=stdout,fmt='(a)') 'Reading eos_amsua 1b data from airs.bufr'
 152          filename = ' '
 153          write(filename(1:9), fmt='(a)') 'airs.bufr'
 154          call da_read_obs_bufrairs ('eos_amsua',iv, filename)
 155       end if
 156
 157       if (use_hsbobs) then
 158          write(unit=stdout,fmt='(a)') 'Reading hsb 1b data from airs.bufr'
 159          filename = ' '
 160          write(filename(1:9), fmt='(a)') 'airs.bufr'
 161          call da_read_obs_bufrairs ('hsb      ',iv, filename)
 162       end if
 163
 164       if (use_ssmisobs) then
 165          write(unit=stdout,fmt='(a)') 'Reading ssmis data from ssmis.bufr'
 166          filename = ' '
 167          write(filename(1:10), fmt='(a)') 'ssmis.bufr'
 168          call da_read_obs_bufrssmis ('ssmis',iv, filename)
 169       end if
 170
 171    end if
 172
 173    if ( use_filtered_rad ) then
 174       write(unit=stdout,fmt='(a)') 'Reading filtered radiance'
 175       call da_read_filtered_rad (iv)
 176    end if
 177
 178    if ( use_simulated_rad ) then
 179       write(unit=stdout,fmt='(a)') 'Reading simulated radiance'
 180       call da_read_simulated_rad (iv)
 181    end if
 182
 183    if ( use_pseudo_rad ) then
 184       write(unit=stdout,fmt='(a)') 'Reading pseudo radiance from namelist'
 185       call da_read_pseudo_rad (iv)
 186    end if
 187
 188    if (use_kma1dvar) then
 189       do i=1,rtminit_nsensor
 190          filename = ' '
 191          filename='kma1dvar-'//trim(iv%instid(i)%rttovid_string)//'.inv'
 192          write(unit=stdout,fmt='(a,a)')  ' Reading KMA 1dvar innovation from  ', filename
 193          call da_read_kma1dvar (i,iv, ob, filename)
 194       end do
 195    end if
 196
 197    if (thinning) then
 198       do n=1,iv%num_inst
 199          call destroygrids (n)
 200       end do
 201       deallocate(thinning_grid)
 202    end if
 203
 204    ! sorting obs into FGAT time bins
 205    call da_sort_rad(iv)
 206
 207    !-----------------------------------------------------------------------------
 208    ! [3.0] create (smaller) ob structure:
 209    !-----------------------------------------------------------------------------
 210
 211    if (.not. use_kma1dvar) then
 212       do i = 1,  ob % num_inst
 213          ob % instid(i) % num_rad = iv % instid(i) % num_rad
 214          if (ob % instid(i) % num_rad < 1) cycle
 215          allocate (ob % instid(i) % tb(ob % instid(i) % nchan,ob % instid(i)%num_rad))
 216          ob % instid(i) % tb(:,:) = iv % instid(i) % tb_inv(:,:)
 217       end do
 218    end if
 219
 220 ! Calculate DT for Cloudy Radiance DA
 221
 222    if (use_rad .and. crtm_cloud .and. .not. DT_cloud_model) then
 223       its = grid%xp % its
 224       ite = grid%xp % ite
 225       jts = grid%xp % jts
 226       jte = grid%xp % jte
 227       kts = grid%xp % kts
 228       kte = grid%xp % kte
 229
 230       grid%xb%delt(its:ite,jts:jte,kts:kte) = 0.0
 231
 232       do inst= 1, iv % num_inst
 233          do n=1,iv%instid(inst)%num_rad
 234              i = int(iv%instid(inst)%info%i(1,n))
 235              j = int(iv%instid(inst)%info%j(1,n))
 236              grid%xb%delt(i:i+1, j:j+1, kts:kte) = 1800.0
 237          end do
 238       end do
 239    endif
 240
 241
 242    if (trace_use) call da_trace_exit("da_setup_radiance_structures")
 243
 244 end subroutine da_setup_radiance_structures
 245