da_qc_rad.inc
References to this file elsewhere.
1 subroutine da_qc_rad (ob, iv)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: perform quality control for radiance data.
5 !
6 ! METHOD: seperated QC for each sensor
7 !---------------------------------------------------------------------------
8
9 implicit none
10
11 type (y_type), intent(in) :: ob ! Observation structure.
12 type (iv_type), intent(inout) :: iv ! O-B structure.
13
14 #ifdef RTTOV
15 integer :: i, nchan,p,j
16 logical :: amsua, amsub, hirs, msu,airs,hsb
17
18 integer, allocatable :: index(:)
19 integer :: num_tovs_avg
20 integer, allocatable :: excess_count(:)
21 integer, allocatable :: spare_count(:)
22 integer :: transfer
23 logical :: copy_found
24 integer :: temp(num_procs)
25
26 if (trace_use) call da_trace_entry("da_qc_rad")
27
28 allocate (num_tovs_before(iv%num_inst,num_procs))
29 allocate (num_tovs_after(iv%num_inst,num_procs))
30
31 ! Cannot be more total send,receives than combination of processors
32 allocate (tovs_copy_count(iv%num_inst))
33 allocate (tovs_send_pe(iv%num_inst,num_procs*num_procs))
34 allocate (tovs_recv_pe(iv%num_inst,num_procs*num_procs))
35 allocate (tovs_send_start(iv%num_inst,num_procs*num_procs))
36 allocate (tovs_send_count(iv%num_inst,num_procs*num_procs))
37 allocate (tovs_recv_start(iv%num_inst,num_procs*num_procs))
38
39 call da_trace("da_qc_rad", message="allocated tovs redistibution arrays")
40
41 allocate (index(num_procs))
42 allocate (excess_count(num_procs))
43 allocate (spare_count(num_procs))
44
45 do i = 1, iv%num_inst
46 nchan = iv%instid(i)%nchan
47
48 amsua = trim(inst_name(rtminit_sensor(i))) == 'amsua'
49 amsub = trim(inst_name(rtminit_sensor(i))) == 'amsub'
50 hirs = trim(inst_name(rtminit_sensor(i))) == 'hirs'
51 msu = trim(inst_name(rtminit_sensor(i))) == 'msu'
52 airs = trim(inst_name(rtminit_sensor(i))) == 'airs'
53 hsb = trim(inst_name(rtminit_sensor(i))) == 'hsb'
54
55 if (hirs) then
56 ! 1.0 QC for HIRS
57 call da_qc_hirs(i,nchan,ob,iv)
58 !call da_warning(__FILE__,__LINE__,(/'QC Not implemented for HIRS'/))
59 else if (airs) then
60 call da_qc_airs(i,nchan,ob,iv)
61 !call da_warning(__FILE__,__LINE__,(/'QC Not implemented for AIRS'/))
62 else if ( hsb ) then
63 ! call da_qc_hsb(i,nchan,ob,iv)
64 call da_warning(__FILE__,__LINE__,(/'QC Not implemented for HSB'/))
65 else if (amsua) then
66 call da_qc_amsua(i,nchan,ob,iv)
67 else if ( amsub ) then
68 call da_qc_amsub(i,nchan,ob,iv)
69 else if (msu) then
70 ! call da_qc_msu(i,nchan, ob,iv)
71 call da_warning(__FILE__,__LINE__,(/'QC Not implemented for MSU'/))
72 else
73 write(unit=message(1),fmt='(A,A)') &
74 "Unrecognized instrument",trim(inst_name(rtminit_sensor(i)))
75 call da_error(__FILE__,__LINE__,message(1:1))
76 end if
77
78 ! Report number of observations to other processors via rootproc
79
80 num_tovs_before(i,:) = 0
81 num_tovs_before(i,myproc+1)=iv%instid(i)%num_rad
82 temp(:)= num_tovs_before(i,:)
83 call da_proc_sum_ints(temp(:))
84
85 #ifdef DM_PARALLEL
86 call wrf_dm_bcast_integer(temp(:),num_procs)
87 #endif
88 num_tovs_before(i,:) = temp(:)
89
90 num_tovs_after(i,:) = num_tovs_before(i,:)
91
92 if (rootproc .and. print_detail_rad) then
93 write(unit=message(1),fmt='(A,I1,A)') "Instrument ",i, &
94 " initial tovs distribution"
95 write(unit=message(2),fmt=*) num_tovs_before(i,:)
96 call da_message(message(1:2))
97 end if
98
99 ! Decide how to reallocate observations
100
101 num_tovs_avg=sum(num_tovs_before(i,:))/num_procs
102
103 call da_trace_int_sort(num_tovs_before(i,:),num_procs,index)
104
105 do p=1,num_procs
106 excess_count(p)=num_tovs_before(i,index(p))-num_tovs_avg
107 spare_count(p)=num_tovs_avg-num_tovs_before(i,index(p))
108 end do
109
110 tovs_copy_count(i) = 0
111 tovs_send_start(i,:) = 0
112 tovs_send_count(i,:) = 0
113
114 do
115 copy_found = .false.
116 do p=1,num_procs
117 if (spare_count(p) > tovs_min_transfer) then
118 do j=num_procs,1,-1
119 if (excess_count(j) > tovs_min_transfer) then
120 copy_found = .true.
121 tovs_copy_count(i)=tovs_copy_count(i)+1
122 tovs_send_pe(i,tovs_copy_count(i)) = index(j)-1
123 tovs_recv_pe(i,tovs_copy_count(i)) = index(p)-1
124 transfer=min(spare_count(p),excess_count(j))
125 tovs_send_count(i,tovs_copy_count(i)) = transfer
126 tovs_recv_start(i,tovs_copy_count(i)) = num_tovs_after(i,index(p))+1
127 num_tovs_after(i,index(p))=num_tovs_after(i,index(p))+transfer
128 num_tovs_after(i,index(j))=num_tovs_after(i,index(j))-transfer
129 tovs_send_start(i,tovs_copy_count(i)) = num_tovs_after(i,index(j))+1
130 spare_count(p)=spare_count(p)-transfer
131 excess_count(j)=excess_count(j)-transfer
132 exit
133 end if
134 end do
135 end if
136 end do
137 if (.not. copy_found) exit
138 end do
139
140 if (print_detail_rad) then
141 write(unit=message(1),fmt='(A,I1,A)') "Instrument ",i," final tovs distribution"
142 write(unit=message(2),fmt=*) num_tovs_after(i,:)
143 call da_message(message(1:2))
144 end if
145
146 iv % instid(i) % num_rad_glo = sum(num_tovs_after(i,:))
147 end do
148
149 deallocate (index)
150 deallocate (excess_count)
151 deallocate (spare_count)
152
153 if (trace_use) call da_trace_exit("da_qc_rad")
154 #endif
155
156 end subroutine da_qc_rad
157
158