1 SUBROUTINE sort_platform (nobs_max, obs, number_of_obs, &
2 nsynops, nshipss, nmetars, npilots, nsounds, &
3 nsatems, nsatobs, naireps, ngpspws, ngpsztd, &
4 ngpsref, ngpseph, nssmt1s, &
5 nssmt2s, nssmis, ntovss, nothers, namdars, &
6 nqscats, nprofls, nbuoyss, nboguss, nairss ,ntamdar, title)
8 !------------------------------------------------------------------------------
9 ! Count observations per type
11 !------------------------------------------------------------------------------
15 ! F. VANDENBERGHE, March 2001
17 ! 01/13/2003 - Updated for Profiler obs. S. R. H. Rizvi
19 ! 02/04/2003 - Updated for Buoy obs. S. R. H. Rizvi
21 ! 02/11/2003 - Reviewed and modified for Profiler
22 ! and Buoy obs. Y.-R. Guo
23 ! 06/30/2006 - Updated for AIRS retrievals Syed RH Rizvi
24 ! 11/09/2006 - Updated for GPS RO Y.-R. Guo
25 !------------------------------------------------------------------------------
31 CHARACTER (LEN = *), INTENT (in) :: title
32 INTEGER, INTENT (in) :: nobs_max
33 TYPE (report), INTENT (inout), DIMENSION (nobs_max):: obs
34 INTEGER, INTENT (in) :: number_of_obs
35 INTEGER, INTENT (inout) :: nsynops,nshipss,&
48 TYPE (measurement ) ,POINTER :: current
51 CHARACTER (LEN = 40) :: platform
52 INTEGER :: fm, is_sound
53 INTEGER :: nvalids,nmultis,&
57 INCLUDE 'platform_interface.inc'
59 !------------------------------------------------------------------------------!
62 '------------------------------------------------------------------------------'
63 WRITE ( UNIT = 0, FMT = '(A)') TRIM (title)
100 ! 1. LOOP OVER STATIONS
101 ! ====================
104 DO loop_index = 1, number_of_obs
107 ! 1.1 Check if record is valid
108 ! ------------------------
111 IF (obs(loop_index)%info%discard ) THEN
117 nvalids = nvalids + 1
119 ! 1.2 Platform code xx
122 READ (obs (loop_index) % info % platform (4:6), '(I3)') fm
125 WRITE (0,'(A,A,I3,A)') obs (loop_index) % info % platform, &
126 "FM =",fm," IS INVALID."
133 CALL fm_decoder (fm, platform, &
134 synop=nsynops, ship =nshipss, metar=nmetars, &
135 pilot=npilots, sound=nsounds, satem=nsatems, &
136 satob=nsatobs, airep=naireps, gpspw=ngpspws, &
137 gpszd=ngpsztd, gpsrf=ngpsref, gpsep=ngpseph, &
138 ssmt1=nssmt1s, ssmt2=nssmt2s, ssmi =nssmis, &
139 tovs =ntovss, amdar=namdars, qscat=nqscats, &
140 profl=nprofls, buoy =nbuoyss, bogus=nboguss, &
141 airs=nairss, tamdar=ntamdar, other=nothers )
143 ! 1.4 Initialise pointer to surface level
144 ! -----------------------------------
146 current => obs (loop_index) % surface
148 ! 2. LOOP ON UPPER LEVELS
149 ! ========================
154 levels: DO WHILE (ASSOCIATED (current))
156 ! 2.1 Found one level, increment
157 ! --------------------------
159 is_sound = is_sound + 1
160 nuppers = nuppers + 1
161 nlevels = nlevels + 1
163 ! 2.2 Go to next level
166 current => current%next
170 ! 2.3 Count surface obs and sounding
171 ! ------------------------------
173 if (is_sound .gt. 0) then
174 nmultis = nmultis + 1
176 nsingls = nsingls + 1
179 ! 3. ASSIGN THE NUMBER OF UPPER-AIR LEVELS TO STATION
180 ! ===================================================
182 obs (loop_index) % info % levels = nuppers
185 ! 4. GO TO NEXT STATION
186 ! ======================
188 ! 4.1 Go to next valid station
189 ! ------------------------
193 ! 4.2 Go to next station
202 WRITE (0, '(A,I7)') ' SYNOP reports:',nsynops
203 WRITE (0, '(A,I7)') ' SHIPS reports:',nshipss
204 WRITE (0, '(A,I7)') ' BUOY reports:',nbuoyss
205 WRITE (0, '(A,I7)') ' BUGUS reports:',nboguss
206 WRITE (0, '(A,I7)') ' METAR reports:',nmetars
207 WRITE (0, '(A,I7)') ' PILOT reports:',npilots
208 WRITE (0, '(A,I7)') ' SOUND reports:',nsounds
209 WRITE (0, '(A,I7)') ' AMDAR reports:',namdars
210 WRITE (0, '(A,I7)') ' SATEM reports:',nsatems
211 WRITE (0, '(A,I7)') ' SATOB reports:',nsatobs
212 WRITE (0, '(A,I7)') ' AIREP reports:',naireps
213 WRITE (0, '(A,I7)') 'TAMDAR reports:',ntamdar
214 WRITE (0, '(A,I7)') ' GPSPW reports:',ngpspws
215 WRITE (0, '(A,I7)') ' GPSZD reports:',ngpsztd
216 WRITE (0, '(A,I7)') ' GPSRF reports:',ngpsref
217 WRITE (0, '(A,I7)') ' GPSEP reports:',ngpseph
218 WRITE (0, '(A,I7)') ' SSMT1 reports:',nssmt1s
219 WRITE (0, '(A,I7)') ' SSMT2 reports:',nssmt2s
220 WRITE (0, '(A,I7)') ' SSMI reports:',nssmis
221 WRITE (0, '(A,I7)') ' TOVS reports:',ntovss
222 WRITE (0, '(A,I7)') ' QSCAT reports:',nqscats
223 WRITE (0, '(A,I7)') ' PROFL reports:',nprofls
224 WRITE (0, '(A,I7)') ' AIRST reports:',nairss
225 WRITE (0, '(A,I7)') ' OTHER reports:',nothers
226 WRITE (0, '(A,3(I7,A),/)') &
227 ' Total reports:',nsynops+nshipss+nmetars+&
228 npilots+nsounds+nsatems+&
229 nsatobs+naireps+ngpspws+&
230 ngpsztd+ngpsref+ngpseph+&
232 nssmt1s+nssmt2s+nssmis +&
233 ntovss +namdars+nqscats+&
234 nprofls+nbuoyss+nairss+ntamdar+nothers, &
235 " = ",nsingls," single + ",nmultis," multi-level reports."
242 END SUBROUTINE sort_platform