var/da/da_obs/da_add_noise_to_ob.inc

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