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