var/da/da_obs_io/da_write_obs_etkf.inc

   1 subroutine da_write_obs_etkf(ob, iv, re)
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: Writes out components of iv=O-B structure.
   5    !-------------------------------------------------------------------------
   6    !
   7    ! Arthur P. Mizzi (NCAR/MMM) February 2011 Modfied to output the extended ob.etkf file.
   8
   9    implicit none
  10
  11    type (y_type), intent(in)     :: ob      ! Observation structure.
  12    type (iv_type), intent(in)    :: iv      ! O-B structure.
  13    type (y_type), intent(inout)  :: re      ! residual vector.
  14
  15    integer                       :: n, k, num_obs, ios
  16    integer                       :: ounit     ! Output unit
  17    character(len=20)             :: filename
  18    character(len=20)             :: apm_char
  19    integer                       :: apm_index, apm_int
  20    real                          :: apm_plc
  21
  22    if (trace_use) call da_trace_entry("da_write_obs_etkf")
  23
  24    !-------------------------------------------------------------------------
  25    ! Fix output unit
  26    !-------------------------------------------------------------------------
  27
  28    apm_index=0
  29
  30    call da_get_unit(ounit)
  31
  32 #ifdef DM_PARALLEL
  33     write(unit=filename, fmt='(a,i4.4)') 'ob.etkf.', myproc
  34 #else
  35     write(unit=filename, fmt='(a)') 'ob.etkf.0000'
  36 #endif
  37
  38    open (unit=ounit,file=trim(filename),form='formatted',status='replace', &
  39       iostat=ios)
  40    if (ios /= 0) then
  41       call da_error(__FILE__,__LINE__, &
  42          (/"Cannot open ETKF observation file"//filename/))
  43    end if
  44
  45    ! [0] Format for extended ob.etkf files (APM 02-10-2011)
  46
  47 1000 format(3f17.7,2x,a10,2x,2(f6.0,2x),4(f8.2,2x),i10)
  48
  49    ! [1] Transfer surface obs:
  50
  51    if (iv%info(synop)%nlocal > 0) then
  52       num_obs = 0
  53       do n = 1, iv%info(synop)%nlocal
  54          if (iv%info(synop)%proc_domain(1,n)) num_obs = num_obs + 1
  55       end do
  56       if (num_obs > 0) then
  57          num_obs = 0
  58          do n = 1, iv%info(synop)%nlocal
  59             if (iv%info(synop)%proc_domain(1,n)) then
  60                num_obs = num_obs + 1
  61                apm_plc = -888.88
  62 !               read(iv%info(synop)%platform(n)(4:6),*) apm_int
  63                if ( iv%synop(n)%u%qc >= 0 .and. ob%synop(n)%u /= missing_r ) then
  64                   apm_index = apm_index + 1
  65                   write(ounit,1000) ob%synop(n)%u, iv%synop(n)%u%inv, iv%synop(n)%u%error, &
  66                   'WNU', apm_plc, -888.88, iv%info(synop)%lat(1,n), iv%info(synop)%lon(1,n), &
  67                   (ob%synop(n)%p)/100., -888.88, apm_index
  68                end if
  69                if ( iv%synop(n)%v%qc >= 0 .and. ob%synop(n)%v /= missing_r ) then
  70                   apm_index = apm_index + 1
  71                   write(ounit,1000) ob%synop(n)%v, iv%synop(n)%v%inv, iv%synop(n)%v%error, &
  72                   'WNV', apm_plc, -888.88, iv%info(synop)%lat(1,n), iv%info(synop)%lon(1,n), &
  73                   (ob%synop(n)%p)/100., -888.88, apm_index
  74                end if
  75                if ( iv%synop(n)%t%qc >= 0 .and. ob%synop(n)%t /= missing_r ) then
  76                   apm_index = apm_index + 1
  77                   write(ounit,1000) ob%synop(n)%t, iv%synop(n)%t%inv, iv%synop(n)%t%error, &
  78                   'TMP', apm_plc, -888.88, iv%info(synop)%lat(1,n), iv%info(synop)%lon(1,n), &
  79                   (ob%synop(n)%p)/100., -888.88, apm_index
  80                end if
  81                if ( iv%synop(n)%p%qc >= 0 .and. ob%synop(n)%p /= missing_r ) then
  82                   apm_index = apm_index + 1
  83                   write(ounit,1000) ob%synop(n)%p, iv%synop(n)%p%inv, iv%synop(n)%p%error, &
  84                   'PRS', apm_plc, -888.88, iv%info(synop)%lat(1,n), iv%info(synop)%lon(1,n), &
  85                   (ob%synop(n)%p)/100., -888.88, apm_index
  86                end if
  87                if ( iv%synop(n)%q%qc >= 0 .and. ob%synop(n)%q /= missing_r ) then
  88                   apm_index = apm_index + 1
  89                   write(ounit,1000) ob%synop(n)%q, iv%synop(n)%q%inv, iv%synop(n)%q%error, &
  90                   'QVP', apm_plc, -888.88, iv%info(synop)%lat(1,n), iv%info(synop)%lon(1,n), &
  91                   (ob%synop(n)%p)/100., -888.88, apm_index
  92                end if
  93             end if
  94          end do
  95       end if
  96    end if
  97
  98    ! [2] Transfer metar obs:
  99
 100    if (iv%info(metar)%nlocal > 0) then
 101       num_obs = 0
 102       do n = 1, iv%info(metar)%nlocal
 103          if (iv%info(metar)%proc_domain(1,n)) num_obs = num_obs + 1
 104       end do
 105       if (num_obs > 0) then
 106          num_obs = 0
 107          do n = 1, iv%info(metar)%nlocal
 108             if (iv%info(metar)%proc_domain(1,n)) then
 109                num_obs = num_obs + 1
 110                apm_plc = -888.88
 111 !               read(iv%info(metar)%platform(n)(4:6),*) apm_int
 112                if ( iv%metar(n)%u%qc >= 0 .and. ob%metar(n)%u /= missing_r ) then
 113                   apm_index = apm_index + 1
 114                   write(ounit,1000) ob%metar(n)%u, iv%metar(n)%u%inv, iv%metar(n)%u%error, &
 115                   'WNU', apm_plc, -888.88, iv%info(metar)%lat(1,n), iv%info(metar)%lon(1,n), &
 116                   (ob%metar(n)%p)/100., -888.88, apm_index
 117                end if
 118                if ( iv%metar(n)%v%qc >= 0 .and. ob%metar(n)%v /= missing_r ) then
 119                   apm_index = apm_index + 1
 120                   write(ounit,1000) ob%metar(n)%v, iv%metar(n)%v%inv, iv%metar(n)%v%error, &
 121                   'WNV', apm_plc, -888.88, iv%info(metar)%lat(1,n), iv%info(metar)%lon(1,n), &
 122                   (ob%metar(n)%p)/100., -888.88, apm_index
 123                end if
 124                if ( iv%metar(n)%t%qc >= 0 .and. ob%metar(n)%t /= missing_r ) then
 125                   apm_index = apm_index + 1
 126                   write(ounit,1000) ob%metar(n)%t, iv%metar(n)%t%inv, iv%metar(n)%t%error, &
 127                   'TMP', apm_plc, -888.88, iv%info(metar)%lat(1,n), iv%info(metar)%lon(1,n), &
 128                   (ob%metar(n)%p)/100., -888.88, apm_index
 129                end if
 130                if ( iv%metar(n)%p%qc >= 0 .and. ob%metar(n)%p /= missing_r ) then
 131                   apm_index = apm_index + 1
 132                   write(ounit,1000) ob%metar(n)%p, iv%metar(n)%p%inv, iv%metar(n)%p%error, &
 133                   'PRS', apm_plc, -888.88, iv%info(metar)%lat(1,n), iv%info(metar)%lon(1,n), &
 134                   (ob%metar(n)%p)/100., -888.88, apm_index
 135                end if
 136                if ( iv%metar(n)%q%qc >= 0 .and. ob%metar(n)%q /= missing_r ) then
 137                   apm_index = apm_index + 1
 138                   write(ounit,1000) ob%metar(n)%q, iv%metar(n)%q%inv, iv%metar(n)%q%error, &
 139                   'QVP', apm_plc, -888.88, iv%info(metar)%lat(1,n), iv%info(metar)%lon(1,n), &
 140                   (ob%metar(n)%p)/100., -888.88, apm_index
 141                end if
 142             end if
 143          end do
 144       end if
 145    end if
 146
 147    ! [3] Transfer ships obs:
 148
 149    if (iv%info(ships)%nlocal > 0) then
 150       num_obs = 0
 151       do n = 1, iv%info(ships)%nlocal
 152          if (iv%info(ships)%proc_domain(1,n)) num_obs = num_obs + 1
 153       end do
 154       if (num_obs > 0) then
 155          num_obs = 0
 156          do n = 1, iv%info(ships)%nlocal
 157             if (iv%info(ships)%proc_domain(1,n)) then
 158                num_obs = num_obs + 1
 159                apm_plc = -888.88
 160 !               read(iv%info(ships)%platform(n)(4:6),*) apm_int
 161                if ( iv%ships(n)%u%qc >= 0 .and. ob%ships(n)%u /= missing_r ) then
 162                   apm_index = apm_index + 1
 163                   write(ounit,1000) ob%ships(n)%u, iv%ships(n)%u%inv, iv%ships(n)%u%error, &
 164                   'WNU', apm_plc, -888.88, iv%info(ships)%lat(1,n), iv%info(ships)%lon(1,n), &
 165                   (ob%ships(n)%p)/100., -888.88, apm_index
 166                end if
 167                if ( iv%ships(n)%v%qc >= 0 .and. ob%ships(n)%v /= missing_r ) then
 168                   apm_index = apm_index + 1
 169                   write(ounit,1000) ob%ships(n)%v, iv%ships(n)%v%inv, iv%ships(n)%v%error, &
 170                   'WNV', apm_plc, -888.88, iv%info(ships)%lat(1,n), iv%info(ships)%lon(1,n), &
 171                   (ob%ships(n)%p)/100., -888.88, apm_index
 172                end if
 173                if ( iv%ships(n)%t%qc >= 0 .and. ob%ships(n)%t /= missing_r ) then
 174                   apm_index = apm_index + 1
 175                   write(ounit,1000) ob%ships(n)%t, iv%ships(n)%t%inv, iv%ships(n)%t%error, &
 176                   'TMP', apm_plc, -888.88, iv%info(ships)%lat(1,n), iv%info(ships)%lon(1,n), &
 177                   (ob%ships(n)%p)/100., -888.88, apm_index
 178                end if
 179                if ( iv%ships(n)%p%qc >= 0 .and. ob%ships(n)%p /= missing_r ) then
 180                   apm_index = apm_index + 1
 181                   write(ounit,1000) ob%ships(n)%p, iv%ships(n)%p%inv, iv%ships(n)%p%error, &
 182                   'PRS', apm_plc, -888.88, iv%info(ships)%lat(1,n), iv%info(ships)%lon(1,n), &
 183                   (ob%ships(n)%p)/100., -888.88, apm_index
 184                end if
 185                if ( iv%ships(n)%q%qc >= 0 .and. ob%ships(n)%q /= missing_r ) then
 186                   apm_index = apm_index + 1
 187                   write(ounit,1000) ob%ships(n)%q, iv%ships(n)%q%inv, iv%ships(n)%q%error, &
 188                   'QVP',apm_plc, -888.88, iv%info(ships)%lat(1,n), iv%info(ships)%lon(1,n), &
 189                   (ob%ships(n)%p)/100., -888.88, apm_index
 190                end if
 191             end if
 192          end do
 193       end if
 194    end if
 195
 196   ! [4.1] Transfer Geo AMVs Obs:
 197
 198    if (iv%info(geoamv)%nlocal > 0) then
 199       num_obs = 0
 200       do n = 1, iv%info(geoamv)%nlocal
 201         if (iv%info(geoamv)%proc_domain(1,n)) num_obs = num_obs + 1
 202       end do
 203       if (num_obs > 0) then
 204          num_obs = 0
 205          do n = 1, iv%info(geoamv)%nlocal
 206             if (iv%info(geoamv)%proc_domain(1,n)) then
 207                num_obs = num_obs + 1
 208                apm_plc = -888.88
 209 !               read(iv%info(geoamv)%platform(n)(4:6),*) apm_int
 210                do k = 1, iv%info(geoamv)%levels(n)
 211                   if ( iv%geoamv(n)%u(k)%qc >= 0 .and. ob%geoamv(n)%u(k) /= missing_r ) then
 212                      apm_index = apm_index + 1
 213                      write(ounit,1000) ob%geoamv(n)%u(k), iv%geoamv(n)%u(k)%inv, iv%geoamv(n)%u(k)%error, &
 214                      'WNU', apm_plc, -888.88, iv%info(geoamv)%lat(1,n), iv%info(geoamv)%lon(1,n), &
 215                      (iv%geoamv(n)%p(k))/100., -888.88, apm_index
 216                   end if
 217                   if ( iv%geoamv(n)%v(k)%qc >= 0 .and. ob%geoamv(n)%v(k) /= missing_r ) then
 218                      apm_index = apm_index + 1
 219                      write(ounit,1000) ob%geoamv(n)%v(k), iv%geoamv(n)%v(k)%inv, iv%geoamv(n)%v(k)%error, &
 220                      'WNV', apm_plc, -888.88, iv%info(geoamv)%lat(1,n), iv%info(geoamv)%lon(1,n), &
 221                      (iv%geoamv(n)%p(k))/100., -888.88, apm_index
 222                   end if
 223                end do
 224             end if
 225          end do
 226       end if
 227    end if
 228
 229   ! [4.2] Transfer Polar AMVs Obs:
 230
 231    if (iv%info(polaramv)%nlocal > 0) then
 232       num_obs = 0
 233       do n = 1, iv%info(polaramv)%nlocal
 234         if (iv%info(polaramv)%proc_domain(1,n)) num_obs = num_obs + 1
 235       end do
 236       if (num_obs > 0) then
 237          num_obs = 0
 238          do n = 1, iv%info(polaramv)%nlocal
 239             if (iv%info(polaramv)%proc_domain(1,n)) then
 240                num_obs = num_obs + 1
 241                apm_plc = -888.88
 242 !               read(iv%info(polaramv)%platform(n)(4:6),*) apm_int
 243                do k = 1, iv%info(polaramv)%levels(n)
 244                   if ( iv%polaramv(n)%u(k)%qc >= 0 .and. ob%polaramv(n)%u(k) /= missing_r ) then
 245                      apm_index = apm_index + 1
 246                      write(ounit,1000) ob%polaramv(n)%u(k), iv%polaramv(n)%u(k)%inv, iv%polaramv(n)%u(k)%error, &
 247                      'WNU', apm_plc, -888.88, iv%info(polaramv)%lat(1,n), iv%info(polaramv)%lon(1,n), &
 248                      (iv%polaramv(n)%p(k))/100., -888.88, apm_index
 249                   end if
 250                   if ( iv%polaramv(n)%v(k)%qc >= 0 .and. ob%polaramv(n)%v(k) /= missing_r ) then
 251                      apm_index = apm_index + 1
 252                      write(ounit,1000) ob%polaramv(n)%v(k), iv%polaramv(n)%v(k)%inv, iv%polaramv(n)%v(k)%error, &
 253                      'WNV', apm_plc, -888.88, iv%info(polaramv)%lat(1,n), iv%info(polaramv)%lon(1,n), &
 254                      (iv%polaramv(n)%p(k))/100., -888.88, apm_index
 255                   end if
 256                end do
 257             end if
 258          end do
 259       end if
 260    end if
 261
 262    ! [5] Transfer gpspw obs:
 263
 264    if (iv%info(gpspw)%nlocal > 0) then
 265       num_obs = 0
 266       do n = 1, iv%info(gpspw)%nlocal
 267          if (iv%info(gpspw)%proc_domain(1,n)) num_obs = num_obs + 1
 268       end do
 269       if (num_obs > 0) then
 270          num_obs = 0
 271          do n = 1, iv%info(gpspw)%nlocal
 272             if (iv%info(gpspw)%proc_domain(1,n)) then
 273                num_obs = num_obs + 1
 274                apm_plc = -888.88
 275 !               read(iv%info(gpspw)%platform(n)(4:6),*) apm_int
 276                if ( iv%gpspw(n)%tpw%qc >= 0 .and. ob%gpspw(n)%tpw /= missing_r ) then
 277                   apm_index = apm_index + 1
 278                   write(ounit,1000) ob%gpspw(n)%tpw, iv%gpspw(n)%tpw%inv, iv%gpspw(n)%tpw%error, &
 279                   'PWT', apm_plc, -888.88, iv%info(gpspw)%lat(1,n), iv%info(gpspw)%lon(1,n), &
 280                   -888.88, -888.88, apm_index
 281                end if
 282             end if
 283          end do
 284       end if
 285    end if
 286
 287    ! [6] Transfer sonde obs:
 288
 289    if (iv%info(sound)%nlocal > 0) then
 290       num_obs = 0
 291       do n = 1, iv%info(sound)%nlocal
 292         if (iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1
 293       end do
 294       if (num_obs > 0) then
 295          num_obs = 0
 296          do n = 1, iv%info(sound)%nlocal
 297             if (iv%info(sound)%proc_domain(1,n)) then
 298                num_obs = num_obs + 1
 299                apm_plc = 120.
 300 !               read(iv%info(sound)%platform(n)(4:6),*) apm_int
 301                do k = 1, iv%info(sound)%levels(n)
 302                   if ( iv%sound(n)%u(k)%qc >= 0 .and. ob%sound(n)%u(k) /= missing_r ) then
 303                      apm_index = apm_index + 1
 304                      write(ounit,1000) ob%sound(n)%u(k), iv%sound(n)%u(k)%inv, iv%sound(n)%u(k)%error, &
 305                      'WNU', apm_plc, -888.88, iv%info(sound)%lat(1,n), iv%info(sound)%lon(1,n), &
 306                      (iv%sound(n)%p(k))/100., -888.88, apm_index
 307                   end if
 308                   if ( iv%sound(n)%v(k)%qc >= 0 .and. ob%sound(n)%v(k) /= missing_r ) then
 309                      apm_index = apm_index + 1
 310                      write(ounit,1000) ob%sound(n)%v(k), iv%sound(n)%v(k)%inv, iv%sound(n)%v(k)%error, &
 311                      'WNV', apm_plc, -888.88, iv%info(sound)%lat(1,n), iv%info(sound)%lon(1,n), &
 312                      (iv%sound(n)%p(k))/100., -888.88, apm_index
 313                   end if
 314                   if ( iv%sound(n)%t(k)%qc >= 0 .and. ob%sound(n)%t(k) /= missing_r ) then
 315                      apm_index = apm_index + 1
 316                      write(ounit,1000) ob%sound(n)%t(k), iv%sound(n)%t(k)%inv, iv%sound(n)%t(k)%error, &
 317                      'TMP', apm_plc, -888.88, iv%info(sound)%lat(1,n), iv%info(sound)%lon(1,n), &
 318                      (iv%sound(n)%p(k))/100., -888.88, apm_index
 319                   end if
 320                   if ( iv%sound(n)%q(k)%qc >= 0 .and. ob%sound(n)%q(k) /= missing_r ) then
 321                      apm_index = apm_index + 1
 322                      write(ounit,1000) ob%sound(n)%q(k), iv%sound(n)%q(k)%inv, iv%sound(n)%q(k)%error, &
 323                      'QVP', apm_plc, -888.88, iv%info(sound)%lat(1,n), iv%info(sound)%lon(1,n), &
 324                      (iv%sound(n)%p(k))/100., -888.88, apm_index
 325                   end if
 326                end do
 327             end if
 328          end do
 329       end if
 330    end if
 331
 332    if (iv%info(sonde_sfc)%nlocal > 0) then
 333       num_obs = 0
 334       do n = 1, iv%info(sonde_sfc)%nlocal
 335         if (iv%info(sonde_sfc)%proc_domain(1,n)) num_obs = num_obs + 1
 336       end do
 337       if (num_obs > 0) then
 338          num_obs = 0
 339          do n = 1, iv%info(sonde_sfc)%nlocal
 340             if (iv%info(sonde_sfc)%proc_domain(1,n)) then
 341                num_obs = num_obs + 1
 342                apm_plc = 120.
 343 !               read(iv%info(sonde_sfc)%platform(n)(4:6),*) apm_int
 344                   if ( iv%sonde_sfc(n)%u%qc >= 0 .and. ob%sonde_sfc(n)%u /= missing_r ) then
 345                      apm_index = apm_index + 1
 346                      write(ounit,1000) ob%sonde_sfc(n)%u, iv%sonde_sfc(n)%u%inv, iv%sonde_sfc(n)%u%error, &
 347                      'WNU', apm_plc, -888.88, iv%info(sonde_sfc)%lat(1,n), iv%info(sonde_sfc)%lon(1,n), &
 348                      (ob%sonde_sfc(n)%p)/100., -888.88, apm_index
 349                   end if
 350                   if ( iv%sonde_sfc(n)%v%qc >= 0 .and. ob%sonde_sfc(n)%v /= missing_r ) then
 351                      apm_index = apm_index + 1
 352                      write(ounit,1000) ob%sonde_sfc(n)%v, iv%sonde_sfc(n)%v%inv, iv%sonde_sfc(n)%v%error, &
 353                      'WNV', apm_plc, -888.88, iv%info(sonde_sfc)%lat(1,n), iv%info(sonde_sfc)%lon(1,n), &
 354                      (ob%sonde_sfc(n)%p)/100., -888.88, apm_index
 355                   end if
 356                   if ( iv%sonde_sfc(n)%t%qc >= 0 .and. ob%sonde_sfc(n)%t /= missing_r ) then
 357                      apm_index = apm_index + 1
 358                      write(ounit,1000) ob%sonde_sfc(n)%t, iv%sonde_sfc(n)%t%inv, iv%sonde_sfc(n)%t%error, &
 359                      'TMP', apm_plc, -888.88, iv%info(sonde_sfc)%lat(1,n), iv%info(sonde_sfc)%lon(1,n), &
 360                      (ob%sonde_sfc(n)%p)/100., -888.88, apm_index
 361                   end if
 362                   if ( iv%sonde_sfc(n)%p%qc >= 0 .and. ob%sonde_sfc(n)%p /= missing_r ) then
 363                      apm_index = apm_index + 1
 364                      write(ounit,1000) ob%sonde_sfc(n)%p, iv%sonde_sfc(n)%p%inv, iv%sonde_sfc(n)%p%error, &
 365                      'PRS', apm_plc, -888.88, iv%info(sonde_sfc)%lat(1,n), iv%info(sonde_sfc)%lon(1,n), &
 366                      (ob%sonde_sfc(n)%p)/100., -888.88, apm_index
 367                   end if
 368                   if ( iv%sonde_sfc(n)%q%qc >= 0 .and. ob%sonde_sfc(n)%q /= missing_r ) then
 369                      apm_index = apm_index + 1
 370                      write(ounit,1000) ob%sonde_sfc(n)%q, iv%sonde_sfc(n)%q%inv, iv%sonde_sfc(n)%q%error, &
 371                      'QVP', apm_plc, -888.88, iv%info(sonde_sfc)%lat(1,n), iv%info(sonde_sfc)%lon(1,n), &
 372                      (ob%sonde_sfc(n)%p)/100., -888.88, apm_index
 373                   end if
 374             end if
 375          end do
 376       end if
 377    end if
 378
 379   ! [7] Transfer airep obs:
 380
 381    if (iv%info(airep)%nlocal > 0) then
 382       num_obs = 0
 383       do n = 1, iv%info(airep)%nlocal
 384         if (iv%info(airep)%proc_domain(1,n)) num_obs = num_obs + 1
 385       end do
 386       if (num_obs > 0) then
 387          num_obs = 0
 388          do n = 1, iv%info(airep)%nlocal
 389             if (iv%info(airep)%proc_domain(1,n)) then
 390                num_obs = num_obs + 1
 391                apm_plc = -888.88
 392 !               read(iv%info(airep)%platform(n)(4:6),*) apm_int
 393                do k = 1, iv%info(airep)%levels(n)
 394                   if ( iv%airep(n)%u(k)%qc >= 0 .and. ob%airep(n)%u(k) /= missing_r ) then
 395                      apm_index = apm_index + 1
 396                      write(ounit,1000) ob%airep(n)%u(k), iv%airep(n)%u(k)%inv, iv%airep(n)%u(k)%error, &
 397                      'WNU', apm_plc, -888.88, iv%info(airep)%lat(1,n), iv%info(airep)%lon(1,n), &
 398                      (iv%airep(n)%p(k))/100., -888.88, apm_index
 399                   end if
 400                   if ( iv%airep(n)%v(k)%qc >= 0 .and. ob%airep(n)%v(k) /= missing_r ) then
 401                      apm_index = apm_index + 1
 402                      write(ounit,1000) ob%airep(n)%v(k), iv%airep(n)%v(k)%inv, iv%airep(n)%v(k)%error, &
 403                      'WNV', apm_plc, -888.88, iv%info(airep)%lat(1,n), iv%info(airep)%lon(1,n), &
 404                      (iv%airep(n)%p(k))/100., -888.88, apm_index
 405                   end if
 406                   if ( iv%airep(n)%t(k)%qc >= 0 .and. ob%airep(n)%t(k) /= missing_r ) then
 407                      apm_index = apm_index + 1
 408                      write(ounit,1000) ob%airep(n)%t(k), iv%airep(n)%t(k)%inv, iv%airep(n)%t(k)%error, &
 409                      'TMP', apm_plc, -888.88, iv%info(airep)%lat(1,n), iv%info(airep)%lon(1,n), &
 410                      (iv%airep(n)%p(k))/100., -888.88, apm_index
 411                   end if
 412                end do
 413             end if
 414          end do
 415       end if
 416    end if
 417
 418    ! [8] Transfer pilot obs:
 419
 420    if (iv%info(pilot)%nlocal > 0) then
 421       num_obs = 0
 422       do n = 1, iv%info(pilot)%nlocal
 423         if (iv%info(pilot)%proc_domain(1,n)) num_obs = num_obs + 1
 424       end do
 425       if (num_obs > 0) then
 426          num_obs = 0
 427          do n = 1, iv%info(pilot)%nlocal
 428             if (iv%info(pilot)%proc_domain(1,n)) then
 429                num_obs = num_obs + 1
 430                apm_plc = -888.88
 431 !               read(iv%info(pilot)%platform(n)(4:6),*) apm_int
 432                do k = 1, iv%info(pilot)%levels(n)
 433                   if ( iv%pilot(n)%u(k)%qc >= 0 .and. ob%pilot(n)%u(k) /= missing_r ) then
 434                      apm_index = apm_index + 1
 435                      write(ounit,1000) ob%pilot(n)%u(k), iv%pilot(n)%u(k)%inv, iv%pilot(n)%u(k)%error, &
 436                      'WNU', apm_plc, -888.88, iv%info(pilot)%lat(1,n), iv%info(pilot)%lon(1,n), &
 437                      (iv%pilot(n)%p(k))/100, -888.88, apm_index
 438                   end if
 439                   if ( iv%pilot(n)%v(k)%qc >= 0 .and. ob%pilot(n)%v(k) /= missing_r ) then
 440                      apm_index = apm_index + 1
 441                      write(ounit,1000) ob%pilot(n)%v(k), iv%pilot(n)%v(k)%inv, iv%pilot(n)%v(k)%error, &
 442                      'WNV', apm_plc, -888.88, iv%info(pilot)%lat(1,n), iv%info(pilot)%lon(1,n), &
 443                      (iv%pilot(n)%p(k))/100., -888.88, apm_index
 444                   end if
 445                end do
 446             end if
 447          end do
 448       end if
 449    end if
 450
 451    ! [9] Transfer SSM/I obs:SSMI:
 452
 453    if (iv%info(ssmi_rv)%nlocal > 0) then
 454       num_obs = 0
 455       do n = 1, iv%info(ssmi_rv)%nlocal
 456          if (iv%info(ssmi_rv)%proc_domain(1,n)) num_obs = num_obs + 1
 457       end do
 458       if (num_obs > 0) then
 459          num_obs = 0
 460          do n = 1, iv%info(ssmi_rv)%nlocal
 461             if (iv%info(ssmi_rv)%proc_domain(1,n)) then
 462                num_obs = num_obs + 1
 463                apm_plc = -888.88
 464 !               read(iv%info(ssmi_rv)%platform(n)(4:6),*) apm_int
 465                if ( iv%ssmi_rv(n)%speed%qc >= 0 .and. ob%ssmi_rv(n)%speed /= missing_r ) then
 466                   apm_index = apm_index + 1
 467                   write(ounit,1000) ob%ssmi_rv(n)%speed, iv%ssmi_rv(n)%speed%inv, &
 468                                           iv%ssmi_rv(n)%speed%error, &
 469                   'SPD', apm_plc, -888.88, iv%info(ssmi_rv)%lat(1,n), iv%info(ssmi_rv)%lon(1,n), &
 470                   -888.88, -888.88, apm_index
 471                end if
 472                if ( iv%ssmi_rv(n)%tpw%qc >= 0 .and. ob%ssmi_rv(n)%tpw /= missing_r ) then
 473                   apm_index = apm_index + 1
 474                   write(ounit,1000) ob%ssmi_rv(n)%tpw, iv%ssmi_rv(n)%tpw%inv, &
 475                                           iv%ssmi_rv(n)%tpw%error, &
 476                   'PWT', apm_plc, -888.88, iv%info(ssmi_rv)%lat(1,n), iv%info(ssmi_rv)%lon(1,n), &
 477                   -888.88, -888.88, apm_index
 478                end if
 479             end if
 480          end do
 481       end if
 482    end if
 483
 484 ! SSM/I TB not coded.
 485
 486    ! [10] Transfer satem obs:
 487
 488    if (iv%info(satem)%nlocal > 0) then
 489       num_obs = 0
 490       do n = 1, iv%info(satem)%nlocal
 491         if (iv%info(satem)%proc_domain(1,n)) num_obs = num_obs + 1
 492       end do
 493       if (num_obs > 0) then
 494          num_obs = 0
 495          do n = 1, iv%info(satem)%nlocal
 496             if (iv%info(satem)%proc_domain(1,n)) then
 497                num_obs = num_obs + 1
 498                apm_plc = -888.88
 499 !               read(iv%info(satem)%platform(n)(4:6),*) apm_int
 500                do k = 1, iv%info(satem)%levels(n)
 501                   if ( iv%satem(n)%thickness(k)%qc >= 0 .and. ob%satem(n)%thickness(k) /= missing_r ) then
 502                     apm_index = apm_index + 1
 503                     write(ounit,1000) ob%satem(n)%thickness(k), iv%satem(n)%thickness(k)%inv, &
 504                                              iv%satem(n)%thickness(k)%error, &
 505                      'TCK', apm_plc, -888.88, iv%info(satem)%lat(1,n), iv%info(satem)%lon(1,n), &
 506                      (iv%satem(n)%p(k))/100., -888.88, apm_index
 507                   end if
 508                end do
 509             end if
 510          end do
 511       end if
 512    end if
 513
 514 !  SSMT1 SSMT2 not coded.
 515
 516   ! [11] Transfer scatterometer obs:
 517
 518    if (iv%info(qscat)%nlocal > 0) then
 519       num_obs = 0
 520       do n = 1, iv%info(qscat)%nlocal
 521          if (iv%info(qscat)%proc_domain(1,n)) num_obs = num_obs + 1
 522       end do
 523       if (num_obs > 0) then
 524          num_obs = 0
 525          do n = 1, iv%info(qscat)%nlocal
 526             if (iv%info(qscat)%proc_domain(1,n)) then
 527                num_obs = num_obs + 1
 528                apm_plc = -888.88
 529 !               read(iv%info(qscat)%platform(n)(4:6),*) apm_int
 530                if ( iv%qscat(n)%u%qc >= 0 .and. ob%qscat(n)%u /= missing_r ) then
 531                   apm_index = apm_index + 1
 532                   write(ounit,1000) ob%qscat(n)%u, iv%qscat(n)%u%inv, iv%qscat(n)%u%error, &
 533                   'WNU', apm_plc, -888.88, iv%info(qscat)%lat(1,n), iv%info(qscat)%lon(1,n), &
 534                   -888.88, -888.88, apm_index
 535                end if
 536                if ( iv%qscat(n)%v%qc >= 0 .and. ob%qscat(n)%v /= missing_r ) then
 537                   apm_index = apm_index + 1
 538                   write(ounit,1000) ob%qscat(n)%v, iv%qscat(n)%v%inv, iv%qscat(n)%v%error, &
 539                   'WNV', apm_plc, -888.88, iv%info(qscat)%lat(1,n), iv%info(qscat)%lon(1,n), &
 540                   -888.88, -888.88, apm_index
 541                end if
 542             end if
 543          end do
 544       end if
 545    end if
 546
 547   ! [12] Transfer profiler obs:
 548
 549    if (iv%info(profiler)%nlocal > 0) then
 550       num_obs = 0
 551       do n = 1, iv%info(profiler)%nlocal
 552         if (iv%info(profiler)%proc_domain(1,n)) num_obs = num_obs + 1
 553       end do
 554       if (num_obs > 0) then
 555          num_obs = 0
 556          do n = 1, iv%info(profiler)%nlocal
 557             if (iv%info(profiler)%proc_domain(1,n)) then
 558                num_obs = num_obs + 1
 559                apm_plc = -888.88
 560 !               read(iv%info(profiler)%platform(n)(4:6),*) apm_int
 561                do k = 1, iv%info(profiler)%levels(n)
 562                   if ( iv%profiler(n)%u(k)%qc >= 0 .and. ob%profiler(n)%u(k) /= missing_r ) then
 563                      apm_index = apm_index + 1
 564                      write(ounit,1000) ob%profiler(n)%u(k), iv%profiler(n)%u(k)%inv, iv%profiler(n)%u(k)%error, &
 565                      'WNU', apm_plc, -888.88, iv%info(profiler)%lat(1,n), iv%info(profiler)%lon(1,n), &
 566                      (iv%profiler(n)%p(k))/100., -888.88, apm_index
 567                   end if
 568                   if ( iv%profiler(n)%v(k)%qc >= 0 .and. ob%profiler(n)%v(k) /= missing_r ) then
 569                      apm_index = apm_index + 1
 570                      write(ounit,1000) ob%profiler(n)%v(k), iv%profiler(n)%v(k)%inv, iv%profiler(n)%v(k)%error, &
 571                      'WNV', apm_plc, -888.88, iv%info(profiler)%lat(1,n), iv%info(profiler)%lon(1,n), &
 572                      (iv%profiler(n)%p(k))/100., -888.88, apm_index
 573                   end if
 574                end do
 575             end if
 576          end do
 577       end if
 578    end if
 579
 580    ! Transfer Buoy obs:
 581
 582    if (iv%info(buoy)%nlocal > 0) then
 583       num_obs = 0
 584       do n = 1, iv%info(buoy)%nlocal
 585          if (iv%info(buoy)%proc_domain(1,n)) num_obs = num_obs + 1
 586       end do
 587       if (num_obs > 0) then
 588          num_obs = 0
 589          do n = 1, iv%info(buoy)%nlocal
 590             if (iv%info(buoy)%proc_domain(1,n)) then
 591                num_obs = num_obs + 1
 592                apm_plc = -888.88
 593 !               read(iv%info(buoy)%platform(n)(4:6),*) apm_int
 594                if ( iv%buoy(n)%u%qc >= 0 .and. ob%buoy(n)%u /= missing_r ) then
 595                   apm_index = apm_index + 1
 596                   write(ounit,1000) ob%buoy(n)%u, iv%buoy(n)%u%inv, iv%buoy(n)%u%error, &
 597                   'WNU', apm_plc, -888.88, iv%info(buoy)%lat(1,n), iv%info(buoy)%lon(1,n), &
 598                   (ob%buoy(n)%p)/100., -888.88, apm_index
 599                end if
 600                if ( iv%buoy(n)%v%qc >= 0 .and. ob%buoy(n)%v /= missing_r ) then
 601                   apm_index = apm_index + 1
 602                   write(ounit,1000) ob%buoy(n)%v, iv%buoy(n)%v%inv, iv%buoy(n)%v%error, &
 603                   'WNV', apm_plc, -888.88, iv%info(buoy)%lat(1,n), iv%info(buoy)%lon(1,n), &
 604                   (ob%buoy(n)%p)/100., -888.88, apm_index
 605                end if
 606                if ( iv%buoy(n)%t%qc >= 0 .and. ob%buoy(n)%t /= missing_r ) then
 607                   apm_index = apm_index + 1
 608                   write(ounit,1000) ob%buoy(n)%t, iv%buoy(n)%t%inv, iv%buoy(n)%t%error, &
 609                   'TMP', apm_plc, -888.88, iv%info(buoy)%lat(1,n), iv%info(buoy)%lon(1,n), &
 610                   (ob%buoy(n)%p)/100., -888.88, apm_index
 611                end if
 612                if ( iv%buoy(n)%p%qc >= 0 .and. ob%buoy(n)%p /= missing_r ) then
 613                   apm_index = apm_index + 1
 614                   write(ounit,1000) ob%buoy(n)%p, iv%buoy(n)%p%inv, iv%buoy(n)%p%error, &
 615                   'PRS', apm_plc, -888.88, iv%info(buoy)%lat(1,n), iv%info(buoy)%lon(1,n), &
 616                   (ob%buoy(n)%p)/100., -888.88, apm_index
 617                end if
 618                if ( iv%buoy(n)%q%qc >= 0 .and. ob%buoy(n)%q /= missing_r ) then
 619                   apm_index = apm_index + 1
 620                   write(ounit,1000) ob%buoy(n)%q, iv%buoy(n)%q%inv, iv%buoy(n)%q%error, &
 621                   'QVP', apm_plc, -888.88, iv%info(buoy)%lat(1,n), iv%info(buoy)%lon(1,n), &
 622                   (ob%buoy(n)%p)/100., -888.88, apm_index
 623                end if
 624             end if
 625          end do
 626       end if
 627    end if
 628
 629    ! Transfer TC bogus obs:
 630
 631    if (iv%info(bogus)%nlocal > 0) then
 632       num_obs = 0
 633       do n = 1, iv%info(bogus)%nlocal
 634         if (iv%info(bogus)%proc_domain(1,n)) num_obs = num_obs + 1
 635       end do
 636       if (num_obs > 0) then
 637          num_obs = 0
 638          do n = 1, iv%info(bogus)%nlocal
 639             if (iv%info(bogus)%proc_domain(1,n)) then
 640                num_obs = num_obs + 1
 641                apm_plc = -888.88
 642 !               read(iv%info(bogus)%platform(n)(4:6),*) apm_int
 643                do k = 1, iv%info(bogus)%levels(n)
 644                   if ( iv%bogus(n)%u(k)%qc >= 0 .and. ob%bogus(n)%u(k) /= missing_r ) then
 645                      apm_index = apm_index + 1
 646                      write(ounit,1000) ob%bogus(n)%u(k), iv%bogus(n)%u(k)%inv, iv%bogus(n)%u(k)%error, &
 647                      'WNU', apm_plc, -888.88, iv%info(bogus)%lat(1,n), iv%info(bogus)%lon(1,n), &
 648                      (iv%bogus(n)%p(k))/100., -888.88, apm_index
 649                   end if
 650                   if ( iv%bogus(n)%v(k)%qc >= 0 .and. ob%bogus(n)%v(k) /= missing_r ) then
 651                      apm_index = apm_index + 1
 652                      write(ounit,1000) ob%bogus(n)%v(k), iv%bogus(n)%v(k)%inv, iv%bogus(n)%v(k)%error, &
 653                      'WNV', apm_plc, -888.88, iv%info(bogus)%lat(1,n), iv%info(bogus)%lon(1,n), &
 654                      (iv%bogus(n)%p(k))/100., -888.88, apm_index
 655                   end if
 656                   if ( iv%bogus(n)%t(k)%qc >= 0 .and.  ob%bogus(n)%t(k) /= missing_r ) then
 657                      apm_index = apm_index + 1
 658                      write(ounit,1000) ob%bogus(n)%t(k), iv%bogus(n)%t(k)%inv, iv%bogus(n)%t(k)%error, &
 659                      'TMP', apm_plc, -888.88, iv%info(bogus)%lat(1,n), iv%info(bogus)%lon(1,n), &
 660                      (iv%bogus(n)%p(k))/100., -888.88, apm_index
 661                   end if
 662                   if ( iv%bogus(n)%q(k)%qc >= 0 .and. ob%bogus(n)%q(k) /= missing_r ) then
 663                      apm_index = apm_index + 1
 664                      write(ounit,1000) ob%bogus(n)%q(k), iv%bogus(n)%q(k)%inv, iv%bogus(n)%q(k)%error, &
 665                      'QVP', apm_plc, -888.88, iv%info(bogus)%lat(1,n), iv%info(bogus)%lon(1,n), &
 666                      (iv%bogus(n)%p(k))/100., -888.88, apm_index
 667                   end if
 668                end do
 669             end if
 670          end do
 671       end if
 672    end if
 673
 674    ! Transfer AIRS retrievals:
 675
 676    if (iv%info(airsr)%nlocal > 0) then
 677       num_obs = 0
 678       do n = 1, iv%info(airsr)%nlocal
 679         if (iv%info(airsr)%proc_domain(1,n)) num_obs = num_obs + 1
 680       end do
 681       if (num_obs > 0) then
 682          num_obs = 0
 683          do n = 1, iv%info(airsr)%nlocal
 684             if (iv%info(airsr)%proc_domain(1,n)) then
 685                num_obs = num_obs + 1
 686                apm_plc = -888.88
 687 !               read(iv%info(airsr)%platform(n)(4:6),*) apm_int
 688                do k = 1, iv%info(airsr)%levels(n)
 689                   if ( iv%airsr(n)%t(k)%qc >= 0 .and. ob%airsr(n)%t(k) /= missing_r ) then
 690                      apm_index = apm_index + 1
 691                      write(ounit,1000) ob%airsr(n)%t(k), iv%airsr(n)%t(k)%inv, iv%airsr(n)%t(k)%error, &
 692                      'TMP', apm_plc, -888.88, iv%info(airsr)%lat(1,n), iv%info(airsr)%lon(1,n), &
 693                      (iv%airsr(n)%p(k))/100., -888.88, apm_index
 694                   end if
 695                   if ( iv%airsr(n)%q(k)%qc >= 0 .and. ob%airsr(n)%q(k) /= missing_r ) then
 696                      apm_index = apm_index + 1
 697                      write(ounit,1000) ob%airsr(n)%q(k), iv%airsr(n)%q(k)%inv, iv%airsr(n)%q(k)%error, &
 698                      'QVP', apm_plc, -888.88, iv%info(airsr)%lat(1,n), iv%info(airsr)%lon(1,n), &
 699                      (iv%airsr(n)%p(k))/100., -888.88, apm_index
 700                   end if
 701                end do
 702             end if
 703          end do
 704       end if
 705    end if
 706
 707    ! Transfer gpsref obs:
 708
 709    if (iv%info(gpsref)%nlocal > 0) then
 710       num_obs = 0
 711       do n = 1, iv%info(gpsref)%nlocal
 712         if (iv%info(gpsref)%proc_domain(1,n)) num_obs = num_obs + 1
 713       end do
 714       if (num_obs > 0) then
 715          num_obs = 0
 716          do n = 1, iv%info(gpsref)%nlocal
 717             if (iv%info(gpsref)%proc_domain(1,n)) then
 718                num_obs = num_obs + 1
 719                apm_plc = -888.88
 720 !               read(iv%info(gpsref)%platform(n)(4:6),*) apm_int
 721                do k = 1, iv%info(gpsref)%levels(n)
 722                   if ( iv%gpsref(n)%ref(k)%qc >= 0 .and. ob%gpsref(n)%ref(k) /= missing_r ) then
 723                      apm_index = apm_index + 1
 724                      write(ounit,1000) ob%gpsref(n)%ref(k), iv%gpsref(n)%ref(k)%inv, iv%gpsref(n)%ref(k)%error, &
 725                      'REF', apm_plc, -888.88, iv%info(gpsref)%lat(1,n), iv%info(gpsref)%lon(1,n), &
 726                      -888.88, -888.88, apm_index
 727                   end if
 728                end do
 729             end if
 730          end do
 731       end if
 732    end if
 733
 734     !  Transfer tamdar obs:
 735
 736    if (iv%info(tamdar)%nlocal > 0) then
 737       num_obs = 0
 738       do n = 1, iv%info(tamdar)%nlocal
 739         if (iv%info(tamdar)%proc_domain(1,n)) num_obs = num_obs + 1
 740       end do
 741       if (num_obs > 0) then
 742          num_obs = 0
 743          do n = 1, iv%info(tamdar)%nlocal
 744             if (iv%info(tamdar)%proc_domain(1,n)) then
 745                num_obs = num_obs + 1
 746                apm_plc = 220.
 747 !               read(iv%info(tamdar)%platform(n)(4:6),*) apm_int
 748                do k = 1, iv%info(tamdar)%levels(n)
 749                   if ( iv%tamdar(n)%u(k)%qc >= 0 .and. ob%tamdar(n)%u(k) /= missing_r ) then
 750                      apm_index = apm_index + 1
 751                      write(ounit,1000) ob%tamdar(n)%u(k), iv%tamdar(n)%u(k)%inv, iv%tamdar(n)%u(k)%error, &
 752                      'WNU', apm_plc, -888.88, iv%info(tamdar)%lat(1,n), iv%info(tamdar)%lon(1,n), &
 753                      (iv%tamdar(n)%p(k))/100., -888.88, apm_index
 754                   end if
 755                   if ( iv%tamdar(n)%v(k)%qc >= 0 .and. ob%tamdar(n)%v(k) /= missing_r ) then
 756                      apm_index = apm_index + 1
 757                      write(ounit,1000) ob%tamdar(n)%v(k), iv%tamdar(n)%v(k)%inv, iv%tamdar(n)%v(k)%error, &
 758                      'WNV', apm_plc, -888.88, iv%info(tamdar)%lat(1,n), iv%info(tamdar)%lon(1,n), &
 759                      (iv%tamdar(n)%p(k))/100., -888.88, apm_index
 760                   end if
 761                   if ( iv%tamdar(n)%t(k)%qc >= 0 .and. ob%tamdar(n)%t(k) /= missing_r ) then
 762                      apm_index = apm_index + 1
 763                      write(ounit,1000) ob%tamdar(n)%t(k), iv%tamdar(n)%t(k)%inv, iv%tamdar(n)%t(k)%error, &
 764                      'TMP', apm_plc, -888.88, iv%info(tamdar)%lat(1,n), iv%info(tamdar)%lon(1,n), &
 765                      (iv%tamdar(n)%p(k))/100., -888.88, apm_index
 766                   end if
 767                   if ( iv%tamdar(n)%q(k)%qc >= 0 .and. ob%tamdar(n)%q(k) /= missing_r ) then
 768                      apm_index = apm_index + 1
 769                      write(ounit,1000) ob%tamdar(n)%q(k), iv%tamdar(n)%q(k)%inv, iv%tamdar(n)%q(k)%error, &
 770                      'QVP', apm_plc, -888.88, iv%info(tamdar)%lat(1,n), iv%info(tamdar)%lon(1,n), &
 771                      (iv%tamdar(n)%p(k))/100., -888.88, apm_index
 772                   end if
 773                end do
 774             end if
 775          end do
 776       end if
 777    end if
 778
 779    if (iv%info(tamdar_sfc)%nlocal > 0) then
 780       num_obs = 0
 781       do n = 1, iv%info(tamdar_sfc)%nlocal
 782         if (iv%info(tamdar_sfc)%proc_domain(1,n)) num_obs = num_obs + 1
 783       end do
 784       if (num_obs > 0) then
 785          num_obs = 0
 786          do n = 1, iv%info(tamdar_sfc)%nlocal
 787             if (iv%info(tamdar_sfc)%proc_domain(1,n)) then
 788                num_obs = num_obs + 1
 789                apm_plc = 220.
 790 !               read(iv%info(tamdar_sfc)%platform(n)(4:6),*) apm_int
 791                   if ( iv%tamdar_sfc(n)%u%qc >= 0 .and. ob%tamdar_sfc(n)%u /= missing_r ) then
 792                      apm_index = apm_index + 1
 793                      write(ounit,1000) ob%tamdar_sfc(n)%u, iv%tamdar_sfc(n)%u%inv, iv%tamdar_sfc(n)%u%error, &
 794                      'WNU', apm_plc, -888.88, iv%info(tamdar_sfc)%lat(1,n), iv%info(tamdar_sfc)%lon(1,n), &
 795                      (ob%tamdar_sfc(n)%p)/100., -888.88, apm_index
 796                   end if
 797                   if ( iv%tamdar_sfc(n)%v%qc >= 0 .and. ob%tamdar_sfc(n)%v /= missing_r ) then
 798                      apm_index = apm_index + 1
 799                      write(ounit,1000) ob%tamdar_sfc(n)%v, iv%tamdar_sfc(n)%v%inv, iv%tamdar_sfc(n)%v%error, &
 800                      'WNV', apm_plc, -888.88, iv%info(tamdar_sfc)%lat(1,n), iv%info(tamdar_sfc)%lon(1,n), &
 801                      (ob%tamdar_sfc(n)%p)/100., -888.88, apm_index
 802                   end if
 803                   if ( iv%tamdar_sfc(n)%t%qc >= 0 .and. ob%tamdar_sfc(n)%t /= missing_r ) then
 804                      apm_index = apm_index + 1
 805                      write(ounit,1000) ob%tamdar_sfc(n)%t, iv%tamdar_sfc(n)%t%inv, iv%tamdar_sfc(n)%t%error, &
 806                      'TMP', apm_plc, -888.88, iv%info(tamdar_sfc)%lat(1,n), iv%info(tamdar_sfc)%lon(1,n), &
 807                      (ob%tamdar_sfc(n)%p)/100., -888.88, apm_index
 808                   end if
 809                   if ( iv%tamdar_sfc(n)%p%qc >= 0 .and. ob%tamdar_sfc(n)%p /= missing_r ) then
 810                      apm_index = apm_index + 1
 811                      write(ounit,1000) ob%tamdar_sfc(n)%p, iv%tamdar_sfc(n)%p%inv, iv%tamdar_sfc(n)%p%error, &
 812                      'PRS', apm_plc, -888.88, iv%info(tamdar_sfc)%lat(1,n), iv%info(tamdar_sfc)%lon(1,n), &
 813                      (ob%tamdar_sfc(n)%p)/100., -888.88, apm_index
 814                   end if
 815                   if ( iv%tamdar_sfc(n)%q%qc >= 0 .and. ob%tamdar_sfc(n)%q /= missing_r ) then
 816                      apm_index = apm_index + 1
 817                      write(ounit,1000) ob%tamdar_sfc(n)%q, iv%tamdar_sfc(n)%q%inv, iv%tamdar_sfc(n)%q%error, &
 818                      'QVP', apm_plc, -888.88, iv%info(tamdar_sfc)%lat(1,n), iv%info(tamdar_sfc)%lon(1,n), &
 819                      (ob%tamdar_sfc(n)%p)/100., -888.88, apm_index
 820                   end if
 821             end if
 822          end do
 823       end if
 824    end if
 825
 826    close (ounit)
 827    call da_free_unit(ounit)
 828
 829    if (trace_use) call da_trace_exit("da_write_obs_etkf")
 830
 831 end subroutine da_write_obs_etkf
 832