var/da/da_setup_structures/da_setup_obs_structures_ascii.inc

   1 subroutine da_setup_obs_structures_ascii( ob, iv, grid )
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: Define, allocate and read of observation structure.
   5    ! Updates:
   6    !          Syed RH Rizvi NCAR/NESL/MMM/DAS Date:  02/21/2013
   7    !          Updated with thinning option
   8    !-------------------------------------------------------------------------
   9
  10    implicit none
  11
  12    type (y_type),  intent(out)   :: ob  ! Observation structure.
  13    type (iv_type), intent(inout) :: iv  ! O-B structure.
  14    type (domain),  intent(inout) :: grid  ! First guess structure
  15
  16    character(len=filename_len)  :: filename
  17    integer                      :: n, i, j, k
  18    logical                      :: outside, thin_3d
  19    logical                      :: uvq_direct=.false.
  20
  21    if (trace_use) call da_trace_entry("da_setup_obs_structures_ascii")
  22    !-------------------------------
  23    ! 0.0 Make thinning grids
  24    !------------------------------
  25    thin_3d=.false.
  26    if ( thin_conv_ascii ) then
  27       allocate(thinning_grid_conv(num_ob_indexes))
  28       do n = 1, num_ob_indexes
  29          if ( thin_conv_opt(n) <= no_thin ) cycle
  30          if( n == airep .or. n == tamdar ) then
  31             thin_3d=.true.
  32             call make3grids (n,thin_mesh_conv(n), thin_3d)
  33          else
  34             call make3grids (n,thin_mesh_conv(n))
  35          end if
  36       end do
  37    end if
  38
  39    !--------------------------------------------------------------------------
  40    ! [1.0] Scan GTS observation header and get idea of number of obs:
  41    !--------------------------------------------------------------------------
  42
  43    if (num_fgat_time > 1) then
  44 !      filename = ' '
  45
  46       do n=1, num_fgat_time
  47
  48          iv%time = n
  49          filename = ' '
  50
  51         write(filename(1:10), fmt='(a, i2.2, a)') 'ob', n,'.ascii'
  52
  53          ! scan main body of gts observation file
  54          call da_scan_obs_ascii (iv, filename,grid)
  55
  56          if (use_ssmiretrievalobs .or. use_ssmitbobs) then
  57             ! scan SSMI observation file
  58             write(filename(1:9), fmt='(a, i2.2, a)') 'ob', n,'.ssmi'
  59             call da_scan_obs_ssmi (iv, filename)
  60          end if
  61
  62          if (use_lsac) then
  63             call da_scan_obs_lsac(iv)
  64          endif
  65
  66          iv%info(:)%plocal(n) = iv%info(:)%nlocal
  67          iv%info(:)%ptotal(n) = iv%info(:)%ntotal
  68       end do
  69    else
  70       iv%time = 1
  71       call da_scan_obs_ascii(iv, 'ob.ascii', grid)
  72       !-----------------------------------------------------------------------
  73       ! read header of ssmi observation file
  74       !-----------------------------------------------------------------------
  75       if (use_ssmiretrievalobs .or. use_ssmitbobs) then
  76          call da_scan_obs_ssmi(iv, 'ob.ssmi')
  77       end if
  78
  79       if (use_lsac) then
  80          call da_scan_obs_lsac(iv)
  81       endif
  82
  83       do i=1,num_ob_indexes
  84          if (i == radar) cycle
  85          iv%info(i)%plocal(iv%time) = iv%info(i)%nlocal
  86          iv%info(i)%ptotal(iv%time) = iv%info(i)%ntotal
  87       end do
  88    end if
  89
  90    !--------------------------------------------------------------------------
  91    ! Allocate the ob based on input number of obs:
  92    !--------------------------------------------------------------------------
  93    call da_allocate_observations (iv)
  94
  95    if (num_fgat_time > 1) then
  96
  97       do n=1, num_fgat_time
  98          iv%time = n
  99          filename = ' '
 100
 101          write(filename(1:10), fmt='(a, i2.2, a)') 'ob', n,'.ascii'
 102
 103          ! Read gts observation file
 104          call da_read_obs_ascii (iv, filename, uvq_direct, grid)
 105
 106          if (use_ssmiretrievalobs .or. use_ssmitbobs) then
 107             ! read ssmi observation file
 108             write(filename(1:9), fmt='(a, i2.2, a)') 'ob', n,'.ssmi'
 109             call da_read_obs_ssmi (iv, filename)
 110          end if
 111
 112          if (use_lsac) then
 113             call da_read_obs_lsac(iv)
 114          end if
 115
 116          do i=1,num_ob_indexes
 117             if (i == radar) cycle
 118             iv%info(i)%thin_ptotal(n) = iv%info(i)%thin_ntotal
 119             iv%info(i)%thin_plocal(n) = iv%info(i)%thin_nlocal
 120          end do
 121       end do
 122    else
 123       iv%time = 1
 124
 125       call da_read_obs_ascii(iv, 'ob.ascii', uvq_direct, grid)
 126
 127       if (use_ssmiretrievalobs .or. use_ssmitbobs) then
 128          ! read ssmi observation file
 129          call da_read_obs_ssmi (iv, 'ob.ssmi')
 130       end if
 131
 132       if (use_lsac) then
 133          call da_read_obs_lsac(iv)
 134       end if
 135
 136       do i=1,num_ob_indexes
 137          if (i == radar) cycle
 138          iv%info(i)%thin_ptotal(iv%time) = iv%info(i)%thin_ntotal
 139          iv%info(i)%thin_plocal(iv%time) = iv%info(i)%thin_nlocal
 140       end do
 141    end if
 142
 143    if ( use_gpsrefobs .and. (ob_format_gpsro == ob_format_bufr) ) then
 144       call da_read_obs_bufrgpsro(iv)
 145    end if
 146
 147    if ( use_gpsephobs .and. (ob_format_gpsro == ob_format_bufr) ) then
 148       call da_read_obs_bufrgpsro_eph(iv)
 149    end if
 150
 151    !--------------------------------------------------------------------------
 152    ! [2.5] Set all thinned obs missing
 153    !--------------------------------------------------------------------------
 154     if ( thin_conv_ascii ) then
 155        do i = 1, num_ob_indexes
 156           if ( thin_conv_opt(i) <= no_thin ) cycle
 157           if (i == radar) cycle
 158           if ( iv%info(i)%ntotal > 0 ) then
 159              if ( iv%info(i)%nlocal > 0 ) then
 160                 if ( ANY(iv%info(i)%thinned(:,:)) ) then
 161                    if( i == airep .or. i==tamdar ) then
 162                       call da_set_3d_obs_missing(iv,i)  ! assign missing values level-by-level if thinned=true data
 163                    else
 164                       call da_set_obs_missing(iv,i)  ! assign missing values to those thinned=true data
 165                    end if
 166                 end if
 167              end if
 168           end if
 169        end do
 170     end if ! thin_conv_ascii
 171
 172    !--------------------------------------------------------------------------
 173    ! [3.0] Calculate innovation vector (O-B) and create (smaller) ob structure:
 174    !--------------------------------------------------------------------------
 175
 176    if (uvq_direct) then
 177       call da_fill_obs_structures(iv, ob, uvq_direct)
 178    else
 179       call da_fill_obs_structures(iv, ob)
 180    endif
 181
 182
 183
 184    iv%time = 1
 185
 186    if ( thin_conv_ascii ) then
 187       do n = 1, num_ob_indexes
 188          if ( thin_conv_opt(n) <= no_thin ) cycle
 189          if( n == airep .or. n==tamdar ) then
 190             thin_3d=.true.
 191             call destroygrids_conv (n, thin_3d)
 192          else
 193             call destroygrids_conv (n)
 194          end if
 195       end do
 196       deallocate(thinning_grid_conv)
 197    end if
 198
 199    if (trace_use) call da_trace_exit("da_setup_obs_structures_ascii")
 200 end subroutine da_setup_obs_structures_ascii
 201
 202