da_bias_sele.f90
References to this file elsewhere.
1 PROGRAM da_bias_sele
2
3 USE RAD_BIAS
4
5 ! PURPOSE.
6 ! --------
7 ! BIASSELE - TO PERFORM BASIC DATA SELETION FOR BIAS CORRECTION PROGRAMS.
8 !
9
10 IMPLICIT NONE
11
12 TYPE(BIAS) :: tovs
13
14 INTEGER :: ntotal, ngood,nreject(5)
15
16 ! definition of defaut namelist values
17 !--------------------------------------
18 INTEGER :: platform_id, satellite_id, sensor_id
19 INTEGER :: isurf,nscan,ierr
20
21 NAMELIST /INPUTS/ platform_id, satellite_id, sensor_id, &
22 nscan,isurf ! ISURF=1 : sea only
23 ! ISURF=2 : land + sea
24 ! ISURF=3 : land only
25
26 ! 1. read and print namelist
27
28 READ(5,INPUTS,END=100)
29 100 CONTINUE
30 WRITE(6,INPUTS)
31
32 OPEN(UNIT=10,FORM='unformatted') ! Open input file
33 OPEN(UNIT=11,FORM='unformatted') ! Open output file
34
35 READ(UNIT=10,END=990) tovs%nchan, tovs%npred ! Read in data
36 REWIND(UNIT=10)
37
38 allocate(tovs%tb(tovs%nchan))
39 allocate(tovs%omb(tovs%nchan))
40 allocate(tovs%bias(tovs%nchan))
41 allocate(tovs%qc_flag(tovs%nchan))
42 allocate(tovs%cloud_flag(tovs%nchan))
43 allocate(tovs%pred(tovs%npred))
44
45 ntotal = 0
46 ngood = 0
47 nreject = 0
48
49 readloop:&
50 DO
51
52 call da_read_biasprep(tovs,10,ierr)
53 if (ierr == 0) then ! not end
54 continue
55 elseif (ierr == 1) then ! end
56 exit
57 else ! error
58 stop 'read error in cycle_sele'
59 endif
60
61 ntotal = ntotal + 1
62 IF (ntotal < 2 ) THEN
63 CALL PRINT_BIAS(tovs)
64 ENDIF
65
66 ! QC for whole pixel point
67 !-----------------------------
68 ! 2.1 wrong satellite test
69 !-----------------------------
70 IF (tovs%platform_id /= platform_id .or. &
71 tovs%satellite_id /= satellite_id .or. &
72 tovs%sensor_id /= sensor_id ) THEN
73 nreject(1) = nreject(1) + 1
74 CYCLE readloop
75 ENDIF
76
77 !--------------------------------------------------------
78 ! 2.2 wrong scan position
79 !--------------------------------------------------------
80 IF ( tovs%scanpos<1 .or. tovs%scanpos>nscan ) THEN
81 nreject(2) = nreject(2) + 1
82 CYCLE readloop
83 ENDIF
84
85 !---------------------------------
86 ! 2.3 land,sea,height test
87 !---------------------------------
88 IF ( ((tovs%landmask == 0) .AND. & ! over land
89 ((isurf == 1) .OR. (tovs%elevation > 2000.0))) .OR. & ! reject land (ISURF=1, only sea) or above 2km
90 ((tovs%landmask == 1) .AND. (isurf == 3)) ) THEN ! reject sea (ISURF=3, only land)
91 nreject(3) = nreject(3) + 1
92 CYCLE readloop
93 ENDIF
94
95 !------------------------
96 ! 2.4 cloud/rain check
97 !------------------------
98 IF ( any (tovs%cloud_flag /= 1) ) THEN
99 nreject(4) = nreject(4) + 1
100 CYCLE readloop
101 ENDIF
102
103 !-----------------------------------------------
104 ! 2.5 surf_flag check (reject mixture surface)
105 !-----------------------------------------------
106 IF ( (tovs%surf_flag >= 4) ) THEN
107 nreject(5) = nreject(5) + 1
108 CYCLE readloop
109 ENDIF
110
111 ngood = ngood + 1 !! total obs number
112
113 call da_write_biasprep(tovs,11)
114
115 ENDDO readloop
116
117 990 continue
118
119 CLOSE(UNIT=10)
120 CLOSE(UNIT=11)
121
122 deallocate(tovs%tb)
123 deallocate(tovs%omb)
124 deallocate(tovs%bias)
125 deallocate(tovs%qc_flag)
126 deallocate(tovs%cloud_flag)
127 deallocate(tovs%pred)
128
129 write(6,'(a,i10)') ' INPUT NUMBER OF OBS :', ntotal
130 write(6,'(a,i10)') 'OUTPUT NUMBER OF OBS :', ngood
131 write(6,'(a)') 'Rejected OBS by Cheching '
132 write(6,'(a)') 'SENSOR_ID SCANPOS SURFACE/HEIGHT CLOUD/RAIN SURF_FLAG'
133 write(6,'(5i10)') nreject
134
135 END PROGRAM da_bias_sele