subroutine da_write_y (iv, y) !------------------------------------------------------------------------- ! Purpose: Writes out components of y=H(x_inc) structure. !------------------------------------------------------------------------- implicit none type (iv_type), intent(in) :: iv ! O-B structure. type (y_type), intent(in) :: y ! y = H(x_inc) structure. integer :: ounit ! Output file unit. integer :: n, k, num_obs, i, ios real :: f1, f2, f3, f4, f5, f6, f7, dum character(len=filename_len) :: ob_name, filename, file_prefix if (trace_use) call da_trace_entry("da_write_y") !------------------------------------------------------------------------- ! Fix output unit !------------------------------------------------------------------------- if (omb_add_noise) then file_prefix='pert_obs.' else file_prefix='unpert_obs.' end if dum = -999999.9 #ifdef DM_PARALLEL write (unit=filename, fmt='(a,i3.3)') trim(file_prefix), myproc #else write (unit=filename, fmt='(a)') trim(file_prefix)//'000' #endif call da_get_unit(ounit) open (unit=ounit,file=trim(filename),form='formatted', & status='replace', iostat=ios ) if (ios /= 0) then call da_error(__FILE__,__LINE__, & (/"Cannot open (un)perturbed observation file"//filename/)) end if ! [1] Transfer surface obs: if (iv%info(synop)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(synop)%nlocal if (iv%info(synop)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'synop', num_obs num_obs = 0 do n = 1, iv%info(synop)%nlocal if (iv%info(synop)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%synop(n)%u%qc, y%synop(n)%u, f1) call da_check_missing(iv%synop(n)%v%qc, y%synop(n)%v, f2) call da_check_missing(iv%synop(n)%t%qc, y%synop(n)%t, f3) call da_check_missing(iv%synop(n)%p%qc, y%synop(n)%p, f4) call da_check_missing(iv%synop(n)%q%qc, y%synop(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [2] Transfer metar obs: if (iv%info(metar)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(metar)%nlocal if(iv%info(metar)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'metar', num_obs num_obs = 0 do n = 1, iv%info(metar)%nlocal if (iv%info(metar)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%metar(n)%u%qc, y%metar(n)%u, f1) call da_check_missing(iv%metar(n)%v%qc, y%metar(n)%v, f2) call da_check_missing(iv%metar(n)%t%qc, y%metar(n)%t, f3) call da_check_missing(iv%metar(n)%p%qc, y%metar(n)%p, f4) call da_check_missing(iv%metar(n)%q%qc, y%metar(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [3] Transfer ships obs: if (iv%info(ships)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(ships)%nlocal if (iv%info(ships)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'ships', num_obs num_obs = 0 do n = 1, iv%info(ships)%nlocal if (iv%info(ships)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%ships(n)%u%qc, y%ships(n)%u, f1) call da_check_missing(iv%ships(n)%v%qc, y%ships(n)%v, f2) call da_check_missing(iv%ships(n)%t%qc, y%ships(n)%t, f3) call da_check_missing(iv%ships(n)%p%qc, y%ships(n)%p, f4) call da_check_missing(iv%ships(n)%q%qc, y%ships(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [4.1] Transfer Geo. AMVs Obs: if (iv%info(geoamv)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(geoamv)%nlocal if (iv%info(geoamv)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'geoamv', num_obs num_obs = 0 do n = 1, iv%info(geoamv)%nlocal if (iv%info(geoamv)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(geoamv)%levels(n) do k = 1, iv%info(geoamv)%levels(n) call da_check_missing(iv%geoamv(n)%u(k)%qc, & y%geoamv(n)%u(k), f1) call da_check_missing(iv%geoamv(n)%v(k)%qc, & y%geoamv(n)%v(k), f2) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2 , dum,dum,dum, & dum,dum end do end if end do end if end if ! [4.2] Transfer Polar AMVs Obs: if (iv%info(polaramv)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(polaramv)%nlocal if (iv%info(polaramv)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'polaramv', num_obs num_obs = 0 do n = 1, iv%info(polaramv)%nlocal if (iv%info(polaramv)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') iv%info(polaramv)%levels(n) do k = 1, iv%info(polaramv)%levels(n) call da_check_missing(iv%polaramv(n)%u(k)%qc, & y%polaramv(n)%u(k), f1) call da_check_missing(iv%polaramv(n)%v(k)%qc, & y%polaramv(n)%v(k), f2) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2 , dum,dum,dum,& dum,dum end do end if end do end if end if ! [5] Transfer gpspw obs: if (iv%info(gpspw)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(gpspw)%nlocal if (iv%info(gpspw)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'gpspw', num_obs num_obs = 0 do n = 1, iv%info(gpspw)%nlocal if (iv%info(gpspw)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%gpspw(n)%tpw%qc, y%gpspw(n)%tpw, f1) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, dum,dum,dum,dum, & dum,dum end if end do end if end if ! [6] Transfer sonde obs: if (iv%info(sound)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(sound)%nlocal if (iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'sound', num_obs num_obs = 0 do n = 1, iv%info(sound)%nlocal if (iv%info(sound)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(sound)%levels(n) do k = 1, iv%info(sound)%levels(n) call da_check_missing(iv%sound(n)%u(k)%qc, y%sound(n)%u(k), f1) call da_check_missing(iv%sound(n)%v(k)%qc, y%sound(n)%v(k), f2) call da_check_missing(iv%sound(n)%t(k)%qc, y%sound(n)%t(k), f3) call da_check_missing(iv%sound(n)%q(k)%qc, y%sound(n)%q(k), f4) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, f3, f4, dum, & dum,dum end do end if end do end if num_obs = 0 do n = 1, iv%info(sound)%nlocal if (iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'sonde_sfc', num_obs num_obs = 0 do n = 1, iv%info(sound)%nlocal if (iv%info(sound)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%sonde_sfc(n)%u%qc, y%sonde_sfc(n)%u, f1) call da_check_missing(iv%sonde_sfc(n)%v%qc, y%sonde_sfc(n)%v, f2) call da_check_missing(iv%sonde_sfc(n)%t%qc, y%sonde_sfc(n)%t, f3) call da_check_missing(iv%sonde_sfc(n)%p%qc, y%sonde_sfc(n)%p, f4) call da_check_missing(iv%sonde_sfc(n)%q%qc, y%sonde_sfc(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [7] Transfer airep obs: if (iv%info(airep)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(airep)%nlocal if (iv%info(airep)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'airep', num_obs num_obs = 0 do n = 1, iv%info(airep)%nlocal if (iv%info(airep)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') iv%info(airep)%levels(n) do k = 1, iv%info(airep)%levels(n) call da_check_missing(iv%airep(n)%u(k)%qc, y%airep(n)%u(k), f1) call da_check_missing(iv%airep(n)%v(k)%qc, y%airep(n)%v(k), f2) call da_check_missing(iv%airep(n)%t(k)%qc, y%airep(n)%t(k), f3) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, f3, dum,dum, & dum,dum end do end if end do end if end if ! [8] Transfer pilot obs: if (iv%info(pilot)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(pilot)%nlocal if (iv%info(pilot)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'pilot', num_obs num_obs = 0 do n = 1, iv%info(pilot)%nlocal if (iv%info(pilot)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(pilot)%levels(n) do k = 1, iv%info(pilot)%levels(n) call da_check_missing(iv%pilot(n)%u(k)%qc, y%pilot(n)%u(k), f1) call da_check_missing(iv%pilot(n)%v(k)%qc, y%pilot(n)%v(k), f2) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, dum,dum,dum, & dum,dum end do end if end do end if end if ! [9] Transfer SSM/I obs:SSMI: if (iv%info(ssmi_rv)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(ssmi_rv)%nlocal if (iv%info(ssmi_rv)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'ssmir', num_obs num_obs = 0 do n = 1, iv%info(ssmi_rv)%nlocal if (iv%info(ssmi_rv)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%ssmi_rv(n)%speed%qc, & y % ssmi_rv(n) % speed, f1) call da_check_missing(iv%ssmi_rv(n)% tpw % qc, & y % ssmi_rv(n) % tpw, f2) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, dum,dum,dum, & dum,dum end if end do end if end if if (iv%info(ssmi_tb)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(ssmi_tb)%nlocal if (iv%info(ssmi_tb)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'ssmiT', num_obs num_obs = 0 do n = 1, iv%info(ssmi_tb)%nlocal if (iv%info(ssmi_tb)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%ssmi_tb(n)%tb19h%qc, & y %ssmi_tb(n)%tb19h, f1) call da_check_missing(iv%ssmi_tb(n)%tb19v%qc, & y %ssmi_tb(n)%tb19v, f2) call da_check_missing(iv%ssmi_tb(n)%tb22v%qc, & y %ssmi_tb(n)%tb22v, f3) call da_check_missing(iv%ssmi_tb(n)%tb37h%qc, & y %ssmi_tb(n)%tb37h, f4) call da_check_missing(iv%ssmi_tb(n)%tb37v%qc, & y %ssmi_tb(n)%tb37v, f5) call da_check_missing(iv%ssmi_tb(n)%tb85h%qc, & y %ssmi_tb(n)%tb85h, f6) call da_check_missing(iv%ssmi_tb(n)%tb85v%qc, & y %ssmi_tb(n)%tb85v, f7) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, f6, f7 end if end do end if end if ! [10] Transfer satem obs: if (iv%info(satem)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(satem)%nlocal if (iv%info(satem)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'satem', num_obs num_obs = 0 do n = 1, iv%info(satem)%nlocal if (iv%info(satem)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(satem)%levels(n) do k = 1, iv%info(satem)%levels(n) call da_check_missing(iv%satem(n)%thickness(k)%qc, & y % satem(n) % thickness(k), f1) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, dum,dum,dum,dum, & dum,dum end do end if end do end if end if ! [11] Transfer ssmt1 obs: if (iv%info(ssmt1)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(ssmt1)%nlocal if (iv%info(ssmt1)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'ssmt1', num_obs num_obs = 0 do n = 1, iv%info(ssmt1)%nlocal if (iv%info(ssmt1)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(ssmt1)%levels(n) do k = 1, iv%info(ssmt1)%levels(n) call da_check_missing(iv%ssmt1(n)%t(k)%qc, & y % ssmt1(n) % t(k), f1) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, dum,dum,dum,dum, & dum,dum end do end if end do end if end if ! [12] Transfer ssmt2 obs: if (iv%info(ssmt2)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(ssmt2)%nlocal if (iv%info(ssmt2)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'ssmt2', num_obs num_obs = 0 do n = 1, iv%info(ssmt2)%nlocal if (iv%info(ssmt2)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(ssmt2)%levels(n) do k = 1, iv%info(ssmt2)%levels(n) call da_check_missing(iv%ssmt2(n)%rh(k)%qc, & y % ssmt2(n) % rh(k), f1) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, dum,dum,dum,dum, & dum,dum end do end if end do end if end if ! [13] Transfer scatterometer obs: if (iv%info(qscat)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(qscat)%nlocal if (iv%info(qscat)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'qscat', num_obs num_obs = 0 do n = 1, iv%info(qscat)%nlocal if (iv%info(qscat)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%qscat(n)%u%qc, y%qscat(n)%u, f1) call da_check_missing(iv%qscat(n)%v%qc, y%qscat(n)%v, f2) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, dum,dum,dum, & dum,dum end if end do end if end if ! [14] Transfer profiler obs: if (iv%info(profiler)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(profiler)%nlocal if (iv%info(profiler)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'profiler', num_obs num_obs = 0 do n = 1, iv%info(profiler)%nlocal if (iv%info(profiler)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(profiler)%levels(n) do k = 1, iv%info(profiler)%levels(n) call da_check_missing(iv%profiler(n)%u(k)%qc, & y%profiler(n)%u(k), f1) call da_check_missing(iv%profiler(n)%v(k)%qc, & y%profiler(n)%v(k), f2) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, dum,dum,dum, & dum,dum end do end if end do end if end if ! [15] Transfer buoy obs: if (iv%info(buoy)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(buoy)%nlocal if (iv%info(buoy)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'buoy', num_obs num_obs = 0 do n = 1, iv%info(buoy)%nlocal if (iv%info(buoy)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%buoy(n)%u%qc, y%buoy(n)%u, f1) call da_check_missing(iv%buoy(n)%v%qc, y%buoy(n)%v, f2) call da_check_missing(iv%buoy(n)%t%qc, y%buoy(n)%t, f3) call da_check_missing(iv%buoy(n)%p%qc, y%buoy(n)%p, f4) call da_check_missing(iv%buoy(n)%q%qc, y%buoy(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [16] Transfer TC bogus obs: if (iv%info(bogus)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(bogus)%nlocal if (iv%info(bogus)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'bogus', num_obs num_obs = 0 do n = 1, iv%info(bogus)%nlocal if (iv%info(bogus)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, dum,dum,dum,dum,dum,dum write(ounit,'(i8)')iv%info(bogus)%levels(n) do k = 1, iv%info(bogus)%levels(n) call da_check_missing(iv%bogus(n)%u(k)%qc, y%bogus(n)%u(k), f2) call da_check_missing(iv%bogus(n)%v(k)%qc, y%bogus(n)%v(k), f3) call da_check_missing(iv%bogus(n)%t(k)%qc, y%bogus(n)%t(k), f4) call da_check_missing(iv%bogus(n)%q(k)%qc, y%bogus(n)%q(k), f5) write(ounit,'(2i8,7e15.7)')num_obs, k, f2, f3, f4, f5, dum, & dum,dum end do end if end do end if end if ! [17] Transfer AIRS retrievals: if (iv%info(airsr)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(airsr)%nlocal if (iv%info(airsr)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'airsr', num_obs num_obs = 0 do n = 1, iv%info(airsr)%nlocal if (iv%info(airsr)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(airsr)%levels(n) do k = 1, iv%info(airsr)%levels(n) call da_check_missing(iv%airsr(n)%t(k)%qc, y%airsr(n)%t(k), f1) call da_check_missing(iv%airsr(n)%q(k)%qc, y%airsr(n)%q(k), f2) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, dum, dum, & dum, dum,dum end do end if end do end if end if ! [18] Transfer Radiance obs: if (iv%num_inst > 0) then do i = 1, iv%num_inst ! loop for sensor if (iv%instid(i)%num_rad < 1) cycle do k = 1,iv%instid(i)%nchan ! loop for channel ! Counting number of obs for channel k num_obs = 0 do n = 1,iv%instid(i)%num_rad ! loop for pixel if (iv%instid(i)%info%proc_domain(1,n) .and. & (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer)) then num_obs = num_obs + 1 end if end do ! end loop for pixel if (num_obs < 1) cycle write(ob_name,'(a,a,i4.4)') trim(iv%instid(i)%rttovid_string),'-', & iv%instid(i)%ichan(k) write(ounit,'(a20,i8)') ob_name,num_obs num_obs = 0 do n= 1, iv%instid(i)%num_rad ! loop for pixel if(iv%instid(i)%info%proc_domain(1,n) .and. & (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer)) then num_obs = num_obs + 1 write(ounit,'(2i8,e15.7)')num_obs, 1, y%instid(i)%tb(k,n) end if end do ! end loop for pixel end do ! end loop for channel end do ! end loop for sensor end if ! [19] Transfer gpsref obs: if (iv%info(gpsref)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(gpsref)%nlocal if (iv%info(gpsref)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'gpsref', num_obs num_obs = 0 do n = 1, iv%info(gpsref)%nlocal if (iv%info(gpsref)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(gpsref)%levels(n) do k = 1, iv%info(gpsref)%levels(n) call da_check_missing(iv%gpsref(n)%ref(k)%qc, y%gpsref(n)%ref(k), f1) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, dum, dum, dum, dum, dum,dum end do end if end do end if end if ! [20] Transfer tamdar obs: if (iv%info(tamdar)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(tamdar)%nlocal if (iv%info(tamdar)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'tamdar', num_obs num_obs = 0 do n = 1, iv%info(tamdar)%nlocal if (iv%info(tamdar)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)')iv%info(tamdar)%levels(n) do k = 1, iv%info(tamdar)%levels(n) call da_check_missing(iv%tamdar(n)%u(k)%qc, y%tamdar(n)%u(k), f1) call da_check_missing(iv%tamdar(n)%v(k)%qc, y%tamdar(n)%v(k), f2) call da_check_missing(iv%tamdar(n)%t(k)%qc, y%tamdar(n)%t(k), f3) call da_check_missing(iv%tamdar(n)%q(k)%qc, y%tamdar(n)%q(k), f4) write(ounit,'(2i8,7e15.7)')num_obs, k, f1, f2, f3, f4, dum, & dum,dum end do end if end do end if num_obs = 0 do n = 1, iv%info(tamdar)%nlocal if (iv%info(tamdar)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'sonde_sfc', num_obs num_obs = 0 do n = 1, iv%info(tamdar)%nlocal if (iv%info(tamdar)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%tamdar_sfc(n)%u%qc, y%tamdar_sfc(n)%u, f1) call da_check_missing(iv%tamdar_sfc(n)%v%qc, y%tamdar_sfc(n)%v, f2) call da_check_missing(iv%tamdar_sfc(n)%t%qc, y%tamdar_sfc(n)%t, f3) call da_check_missing(iv%tamdar_sfc(n)%p%qc, y%tamdar_sfc(n)%p, f4) call da_check_missing(iv%tamdar_sfc(n)%q%qc, y%tamdar_sfc(n)%q, f5) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, f2, f3, f4, f5, & dum,dum end if end do end if end if ! [21] Transfer rainfall obs: if (iv%info(rain)%nlocal > 0) then num_obs = 0 do n = 1, iv%info(rain)%nlocal if (iv%info(rain)%proc_domain(1,n)) num_obs = num_obs + 1 end do if (num_obs > 0) then write(ounit,'(a20,i8)')'rain', num_obs num_obs = 0 do n = 1, iv%info(rain)%nlocal if (iv%info(rain)%proc_domain(1,n)) then num_obs = num_obs + 1 write(ounit,'(i8)') 1 call da_check_missing(iv%rain(n)%rain%qc, y%rain(n)%rain, f1) write(ounit,'(2i8,7e15.7)')num_obs, 1, f1, dum,dum,dum,dum, & dum,dum end if end do end if end if close (ounit) call da_free_unit(ounit) if (trace_use) call da_trace_exit("da_write_y") end subroutine da_write_y