Update version info for release v4.6.1 (#2122)
[WRF.git] / var / obsproc / src / sort_platform.F90
blob4ac9f824871a694a7f5ae2f783d0888dfbad411c
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 !------------------------------------------------------------------------------
13 !  HISTORY: 
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 !------------------------------------------------------------------------------
27   USE module_type
29   IMPLICIT NONE
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,&
36                                                                nmetars,npilots,&
37                                                                nsounds,nsatems,&
38                                                                nsatobs,naireps,&
39                                                                ngpspws,nssmt1s,&
40                                                                nssmt2s,nssmis, &
41                                                                ntovss, namdars,&
42                                                                nqscats,nprofls,&
43                                                                nbuoyss,nothers,&
44                                                                nboguss,nairss, &
45                                                                ngpsztd,ngpsref,&
46                                                                ngpseph,ntamdar
48   TYPE (measurement ) ,POINTER                              :: current
49   INTEGER                                                   :: loop_index
51   CHARACTER (LEN = 40)                                      :: platform
52   INTEGER                                                   :: fm, is_sound
53   INTEGER                                                   :: nvalids,nmultis,&
54                                                                nsingls,nlevels
55   INTEGER                                                   :: nuppers
57   INCLUDE 'platform_interface.inc'
59 !------------------------------------------------------------------------------!
61               WRITE (0,'(A)')  &
62 '------------------------------------------------------------------------------'
63       WRITE ( UNIT = 0, FMT = '(A)') TRIM (title)
66 ! 0.  RESET
67 ! =========
69       nvalids = 0
70       nmultis = 0
71       nsingls = 0
72       nlevels = 0
74       nsynops = 0
75       nmetars = 0
76       nshipss = 0
77       npilots = 0
78       nsounds = 0
79       namdars = 0
80       nsatems = 0
81       nsatobs = 0
82       ntamdar = 0
83       naireps = 0
84       ngpspws = 0
85       ngpsztd = 0
86       ngpsref = 0
87       ngpseph = 0
88       nssmt1s = 0
89       nssmt2s = 0
90       nssmis  = 0
91       ntovss  = 0
92       nqscats = 0
93       nprofls = 0
94       nbuoyss = 0
95       nboguss = 0
96       nairss  = 0
97       nothers = 0
100 ! 1. LOOP OVER STATIONS
101 ! ====================
103 stations: &
104       DO loop_index = 1, number_of_obs
107 ! 1.1 Check if record is valid
108 !     ------------------------
110 stations_valid: &
111       IF (obs(loop_index)%info%discard ) THEN
113       CYCLE  stations
115       ELSE stations_valid
117       nvalids = nvalids + 1
119 ! 1.2 Platform code xx
120 !     ----------------
122        READ (obs (loop_index) % info % platform (4:6), '(I3)') fm
124        IF (fm .LE. 0)  THEN
125            WRITE (0,'(A,A,I3,A)') obs (loop_index) % info % platform, &
126                                   "FM =",fm," IS INVALID."
127            CYCLE  stations
128        ENDIF
131 ! 1.3 interpret code
132 !     ---------------
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 ! ========================
151       is_sound  = -1
152       nuppers   =  0
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
164 !     ----------------
166       current => current%next
168       ENDDO levels
170 ! 2.3 Count surface obs and sounding
171 !     ------------------------------
173       if (is_sound .gt. 0) then
174           nmultis = nmultis + 1
175       else
176           nsingls = nsingls + 1
177       endif
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 !     ------------------------
191       ENDIF  stations_valid
193 ! 4.2 Go to next station
194 !     ------------------
195       ENDDO  stations
198 ! 5.  PRINT OUT
199 ! =============
201       WRITE (0, '(A)')
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+&
231                                             nboguss+&
232                                             nssmt1s+nssmt2s+nssmis +&
233                                             ntovss +namdars+nqscats+&
234                                             nprofls+nbuoyss+nairss+ntamdar+nothers, &
235       " = ",nsingls," single + ",nmultis," multi-level reports."
238 ! 4.  END
239 ! =======
240       RETURN
242       END SUBROUTINE sort_platform