var/obsproc/src/module_duplicate.F90

   1 MODULE module_duplicate
   2
   3 !-----------------------------------------------------------------------------!
   4 ! Sort observations by location and time,
   5 ! Merge space duplicate stations (same type, same location, same time),
   6 ! Remove time duplicate stations in time (same type & location, different
   7 ! time),
   8 !
   9 !  HISTORY:
  10 !
  11 ! D. GILL,         April 1998
  12 ! F. VANDENBERGHE, March 2001
  13 !
  14 !         01/13/2003 - Updated for Profiler obs.           S. R. H. Rizvi
  15 !
  16 !         02/04/2003 - Updated for Buoy     obs.           S. R. H. Rizvi
  17 !
  18 !         02/11/2003 - Reviewed and modified for Profiler
  19 !                      and Buoy obs.                       Y.-R. Guo
  20 !
  21 !         08/31/2004 - Corrected check_duplicate_time for retaining obs
  22 !                      closer to analysis time             S. R. H. Rizvi
  23 !         09/02/2004 - Reviewed the above correction, and add the
  24 !                      modifications for GPS Ref.          Y.-R. Guo
  25 !         06/30/2006 -   Updated for AIRS retrievals       Syed  RH  Rizvi
  26 !
  27 !         11/09/2006 - add the modifications for GPS Excess Phase  Y.-R. Guo
  28 !------------------------------------------------------------------------------
  29
  30 USE module_type
  31 USE module_func
  32
  33 CONTAINS
  34
  35 !-----------------------------------------------------------------------------!
  36 ! SUBROUTINE check_duplicate_loc  (obs,index,num_obs,total_dups,time_analysis,
  37 !                                  print_duplicate
  38 ! SUBROUTINE check_duplicate_time (obs,index,num_obs,total_dups,time_analysis,
  39 !                                  print_duplicate)
  40 !
  41 ! -------------------------------------------------------------------------
  42
  43 SUBROUTINE check_duplicate_loc(obs, index, num_obs, total_dups, time_analysis,&
  44                                 print_duplicate)
  45
  46 !  Checks array of reports (obs), which has a sorted index to the reports,
  47 !  to determine if any reports are for the same time/location.  If so,
  48 !  and the data is duplicated exactly in all fields, one is discarded.  If
  49 !  they are from same time/location and data is not identical, data from
  50 !  two reports is merged:  'missing' is replaced by known values; data at
  51 !  different levels is merged into one linked list.
  52
  53    USE module_date
  54    USE module_obs_merge
  55    USE module_per_type
  56
  57    IMPLICIT NONE
  58
  59    TYPE ( report ) , INTENT ( INOUT ) , DIMENSION ( : ) :: obs
  60    INTEGER         , INTENT ( IN )    , DIMENSION ( : ) :: index
  61    INTEGER         , INTENT ( IN )                      :: num_obs
  62
  63    INTEGER                                :: current , &
  64                                              next    , &
  65                                              first   , &
  66                                              second
  67    INTEGER         , INTENT ( OUT )       :: total_dups
  68 !  INTEGER         , INTENT ( IN  )       :: date    , &
  69 !                                            time
  70    LOGICAL,              INTENT (IN)      :: print_duplicate
  71    CHARACTER (LEN = 19)                   :: time_analysis
  72    INTEGER                                :: total_valid
  73
  74    INTEGER :: century_year, month, day
  75    INTEGER :: hour, minute, seconds
  76    INTEGER :: date, time
  77    INTEGER :: iunit, io_error
  78
  79    CHARACTER (LEN =  80):: filename
  80    CHARACTER (LEN =  80):: proc_name = "check_duplicate_ob"
  81    CHARACTER (LEN = 160):: error_message
  82    LOGICAL              :: fatal, connected
  83
  84    INTEGER              :: fma, fmb
  85    CHARACTER (LEN = 40) :: platforma, platformb
  86    INTEGER              :: nsynopb, nmetarb, nshipsb, &
  87                            nsoundb, npilotb, nairepb, &
  88                            nsatemb, nsatobb, ngpspwb, &
  89                            nssmt1b, nssmt2b, nssmib,  &
  90                            ntovsb,  notherb, namdarb, &
  91                            nqscatb, nproflb, ngpsepb, nbuoysb, &
  92                            ngpszdb, ngpsrfb, nbogusb, &
  93                            nairsb,  ntamdarb
  94    INTEGER              :: nsynopa, nmetara, nshipsa, &
  95                            nsounda, npilota, nairepa, &
  96                            nsatema, nsatoba, ngpspwa, &
  97                            nssmt1a, nssmt2a, nssmia,  &
  98                            ntovsa,  nothera, namdara, &
  99                            nqscata, nprofla, ngpsepa, nbuoysa, &
 100                            ngpszda, ngpsrfa, nbogusa, &
 101                            nairsa,  ntamdara
 102
 103    INCLUDE 'platform_interface.inc'
 104
 105 !------------------------------------------------------------------------------!
 106
 107    WRITE (0,'(A)')  &
 108 '------------------------------------------------------------------------------'
 109    WRITE ( UNIT = 0, FMT = '(A,/)') 'REMOVE DUPLICATE STATIONS BY LOCATION:'
 110
 111       !  Open diagnostic file
 112
 113       IF (print_duplicate) THEN
 114
 115       filename = 'obs_duplicate_loc.diag'
 116       iunit    = 999
 117
 118       INQUIRE ( UNIT = iunit, OPENED = connected )
 119
 120       IF (connected) CLOSE (iunit)
 121
 122       OPEN (UNIT = iunit , FILE = filename , FORM = 'FORMATTED'  , &
 123             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error )
 124
 125       IF (io_error .NE. 0) THEN
 126           CALL error_handler (proc_name, &
 127          "Unable to open output diagnostic file. ", filename, .TRUE.)
 128       ELSE
 129           WRITE (UNIT = 0, FMT = '(A,A,/)') &
 130          "Diagnostics in file ", TRIM (filename)
 131       ENDIF
 132
 133       ENDIF
 134
 135    !  Reset counters
 136
 137    nsynopb = 0; nmetarb = 0; nshipsb = 0;
 138    nsoundb = 0; npilotb = 0; nairepb = 0;
 139    nsatemb = 0; nsatobb = 0; ngpspwb = 0;
 140    nssmt1b = 0; nssmt2b = 0; nssmib  = 0;
 141    ntovsb  = 0; notherb = 0; namdarb = 0;
 142    nqscatb = 0; nproflb = 0; nbuoysb = 0;
 143    nqscatb = 0; nproflb = 0; nbuoysb = 0;
 144    nairsb =0; nairsa = 0
 145    nsynopa = 0; nmetara = 0; nshipsa = 0;
 146    nsounda = 0; npilota = 0; nairepa = 0;
 147    nsatema = 0; nsatoba = 0; ngpspwa = 0;
 148    nssmt1a = 0; nssmt2a = 0; nssmia  = 0;
 149    ntovsa  = 0; nothera = 0; namdara = 0;
 150    nqscata = 0; nprofla = 0; nbuoysa = 0;
 151    ngpszda = 0; ngpszdb = 0; nbogusa = 0;
 152    ngpsrfa = 0; ngpsrfb = 0; nbogusb = 0;
 153    ngpsepa = 0; ngpsepb = 0
 154    ntamdara= 0; ntamdarb= 0
 155    !  Count obs per type before merging
 156
 157 count_before:&
 158    DO current = 1 , num_obs
 159
 160       first = index(current)
 161
 162       !  If this obs has been merged with another obs or discarded, skip it.
 163
 164       IF ( obs(first)%info%discard ) THEN
 165          CYCLE count_before
 166       END IF
 167
 168       !  Count obs present per type before merging
 169
 170       READ (obs(first)  % info % platform (4:6), '(I3)') fmb
 171
 172       CALL fm_decoder (fmb, platformb, &
 173                        synop=nsynopb, ship =nshipsb, metar=nmetarb,&
 174                        pilot=npilotb, sound=nsoundb, satem=nsatemb,&
 175                        satob=nsatobb, airep=nairepb, gpspw=ngpspwb,&
 176                        gpszd=ngpszdb, gpsrf=ngpsrfb, gpsep=ngpsepb,&
 177                        bogus=nbogusb, &
 178                        ssmt1=nssmt1b, ssmt2=nssmt2b, ssmi =nssmib, &
 179                        tovs =ntovsb,  other=notherb, amdar=namdarb,&
 180                        qscat=nqscatb, profl=nproflb, buoy = nbuoysb,&
 181                        airs=nairsb,tamdar=ntamdarb)
 182
 183    ENDDO count_before
 184
 185    !  Break analysis time into ccyymmdd and hhmnss
 186
 187    CALL split_date_char (time_analysis, &
 188                          century_year, month, day, hour, minute, seconds )
 189
 190    date = century_year * 10000 + month  * 100 + day
 191    time = hour         * 10000 + minute * 100 + seconds
 192
 193    !  Count the total number of duplicate reports.
 194
 195    total_dups  = 0
 196    total_valid = 0
 197
 198    !  Merge obs
 199
 200 obsloop:&
 201    DO current = 1 , num_obs - 1
 202
 203       first = index(current)
 204
 205       !  If this obs has been merged with another obs or discarded, skip it.
 206
 207       IF ( obs(first)%info%discard ) THEN
 208          CYCLE obsloop
 209       END IF
 210
 211       total_valid = total_valid + 1
 212
 213       !  Get second obs to compare with first; compare first obs to second obs
 214       !  until next obs does not match.
 215
 216       compare: DO next = current + 1 , num_obs
 217
 218          second = index(next)
 219
 220          ! Sorted by location, so if locations NE, then no chance of any
 221          ! more matches with first.
 222
 223 ! foo
 224 !        IF (.NOT. (obs(first)%location .EQ. obs(second)%location )) THEN
 225          IF (.NOT. loc_eq (obs(first), obs(second))) THEN
 226             CYCLE obsloop
 227          END IF
 228
 229          !  If this obs has been merged with another obs or discarded, skip it.
 230
 231          IF (obs(second)%info%discard) THEN
 232             CYCLE compare
 233          END IF
 234
 235          !  If time fields are not completely identical, go to next observation.
 236          !  Sort is by location ONLY, not by time; so next+1 may be identical
 237          !  even though next has different time.
 238
 239 ! This statements modifies the obs date and time
 240 !        IF (.NOT. time_eq (obs(first)%valid_time, obs(second)%valid_time, &
 241 !            date, time)) THEN
 242
 243          IF (.NOT. time_eq_old (obs(first)%valid_time, obs(second)%valid_time))&
 244          THEN
 245
 246             IF (print_duplicate) THEN
 247
 248             error_message  = ' Found multiple times for ' &
 249             // TRIM ( obs(first)%location%id ) // ' ' &
 250             // TRIM ( obs(first)%location%name ) // ', ' &
 251             // TRIM ( obs(first)%valid_time%date_char )  // ' and ' &
 252             // TRIM ( obs(second)%valid_time%date_char ) // '.'
 253
 254             WRITE (UNIT = iunit, FMT = '(A)') TRIM (error_message)
 255
 256 !           fatal = .false.
 257 !           CALL error_handler (proc_name,  error_message , "", fatal)
 258
 259             ENDIF
 260
 261             CYCLE compare
 262
 263          END IF
 264
 265          !  Observations are from same location and time, so merge them.
 266
 267          CALL merge_obs ( obs(first) , obs(second), print_duplicate, iunit)
 268
 269          !  Mark second of pair as discarded; data is put in 'first'.
 270          !  Note that a duplicate has been found by incrementing the counter.
 271
 272          obs(second)%info%discard  = .true.
 273          obs(first)%info%num_dups  = obs(first)%info%num_dups + 1
 274          total_dups = total_dups + 1
 275
 276          !  Free up the space for the observation report that is discarded.
 277          !  Unfortunately, OR NOT!
 278
 279 ! foo
 280 !        CALL dealloc_meas ( obs(second)%surface )
 281          NULLIFY ( obs(second)%surface )
 282
 283 !        obs (second)%info%discard = .TRUE.
 284
 285       END DO compare
 286
 287    END DO obsloop
 288
 289    total_valid = total_valid + 1
 290
 291    !  Count obs per type after merging
 292
 293 count_after:&
 294    DO current = 1 , num_obs
 295
 296        first = index(current)
 297
 298       !  If this obs has been merged with another obs or discarded, skip it.
 299
 300       IF ( obs(first)%info%discard ) THEN
 301          CYCLE count_after
 302       END IF
 303
 304       !  Count obs present per type before merging
 305
 306       READ (obs(first)  % info % platform (4:6), '(I3)') fma
 307
 308       CALL fm_decoder (fma, platforma, &
 309                        synop=nsynopa, ship =nshipsa, metar=nmetara,&
 310                        pilot=npilota, sound=nsounda, satem=nsatema,&
 311                        satob=nsatoba, airep=nairepa, gpspw=ngpspwa,&
 312                        gpszd=ngpszda, gpsrf=ngpsrfa, gpsep=ngpsepa,&
 313                        bogus=nbogusa, &
 314                        ssmt1=nssmt1a, ssmt2=nssmt2a, ssmi =nssmia, &
 315                        tovs =ntovsa,  other=nothera, amdar=namdara,&
 316                        qscat=nqscata, profl=nprofla, buoy = nbuoysa, &
 317                        airs=nairsa, tamdar=ntamdara)
 318
 319    ENDDO count_after
 320
 321    nsynops (icor) = nsynopb - nsynopa
 322    nmetars (icor) = nmetarb - nmetara
 323    nshipss (icor) = nshipsb - nshipsa
 324    nsounds (icor) = nsoundb - nsounda
 325    namdars (icor) = namdarb - namdara
 326    npilots (icor) = npilotb - npilota
 327    naireps (icor) = nairepb - nairepa
 328    ntamdar (icor) = ntamdarb- ntamdara
 329    nsatems (icor) = nsatemb - nsatema
 330    nsatobs (icor) = nsatobb - nsatoba
 331    ngpspws (icor) = ngpspwb - ngpspwa
 332    ngpsztd (icor) = ngpszdb - ngpszda
 333    ngpsref (icor) = ngpsrfb - ngpsrfa
 334    ngpseph (icor) = ngpsepb - ngpsepa
 335    nssmt1s (icor) = nssmt1b - nssmt1a
 336    nssmt2s (icor) = nssmt2b - nssmt2a
 337    nssmis  (icor) = nssmib  - nssmia
 338    ntovss  (icor) = ntovsb  - ntovsa
 339    nqscats (icor) = nqscatb - nqscata
 340    nprofls (icor) = nproflb - nprofla
 341    nbuoyss (icor) = nbuoysb - nbuoysa
 342    nboguss (icor) = nbogusb - nbogusa
 343    nairss  (icor) = nairsb  - nairsa
 344    nothers (icor) = notherb - nothera
 345
 346    WRITE (UNIT = 0 , FMT = '(A,I7,A,/)' ) &
 347   "Found ",total_dups," location duplicate stations that have been merged."
 348
 349    IF (print_duplicate) CLOSE (iunit)
 350
 351 END SUBROUTINE check_duplicate_loc
 352
 353 !\f
 354 ! -----------------------------------------------------------------------
 355
 356 SUBROUTINE check_duplicate_time (obs, index, num_obs, total_dups, time_analysis,print_duplicate)
 357
 358 !  Checks array of reports (obs), which has a sorted index to the reports,
 359 !  to determine if any reports are for the same location but different time.
 360 !  -If both observations are soundings, then the data closest to the analysis
 361 !   time is kept
 362 !  -If time differences are equal (obs before and after the analysis time),
 363 !   then the obs valid after the analysis time is kept.
 364 !  -If one is a sounding and the other a surface observation, then the sounding
 365 !   is kept whatever the time differences are.
 366 !
 367    USE module_date
 368    USE module_per_type
 369
 370    IMPLICIT NONE
 371
 372    TYPE (report),        INTENT (INOUT), DIMENSION (:) :: obs
 373    INTEGER,              INTENT (IN),    DIMENSION (:) :: index
 374    INTEGER,              INTENT (IN)                   :: num_obs
 375    CHARACTER (LEN = 19), INTENT (INOUT)                :: time_analysis
 376    INTEGER,              INTENT (OUT)                  :: total_dups
 377    LOGICAL,              INTENT (IN)                   :: print_duplicate
 378    INTEGER                                             :: total_valid
 379
 380    INTEGER :: current, next, first, second
 381    CHARACTER (LEN = 19) :: time_first, time_second
 382    INTEGER :: itfirst, itsecond
 383    LOGICAL :: llfirst, llsecond
 384
 385    TYPE (report)               :: obs_tmp
 386    TYPE (measurement), POINTER :: current_tmp
 387    LOGICAL                     :: remove_duplicate = .TRUE.
 388
 389    CHARACTER (LEN = 80)        :: filename
 390    CHARACTER (LEN = 32 ), PARAMETER :: proc_name = 'check_duplicate_time '
 391    LOGICAL                     :: connected
 392    INTEGER                     :: iunit, io_error
 393
 394    INCLUDE 'platform_interface.inc'
 395 !------------------------------------------------------------------------------!
 396
 397               WRITE (0,'(A)')  &
 398 '------------------------------------------------------------------------------'
 399       WRITE ( UNIT = 0, FMT = '(A,/)') 'REMOVE DUPLICATE STATIONS BY TIME:'
 400
 401       !  Open diagnostic file
 402
 403       IF (print_duplicate) THEN
 404
 405       filename = 'obs_duplicate_time.diag_'//time_analysis
 406       iunit    = 999
 407
 408       INQUIRE ( UNIT = iunit, OPENED = connected )
 409
 410       IF (connected) CLOSE (iunit)
 411
 412       OPEN (UNIT = iunit , FILE = filename , FORM = 'FORMATTED'  , &
 413             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error )
 414
 415       IF (io_error .NE. 0) THEN
 416           CALL error_handler (proc_name, &
 417          "Unable to open output diagnostic file. ", filename, .TRUE.)
 418       ELSE
 419           WRITE (UNIT = 0, FMT = '(A,A,/)') &
 420          "Diagnostics in file ", TRIM (filename)
 421       ENDIF
 422
 423       ENDIF
 424
 425    !  Count the total number of duplicate reports.
 426
 427    total_valid = 0
 428    total_dups  = 0
 429
 430    obsloop: DO current = 1 , num_obs - 1
 431
 432       first = index(current)
 433
 434       !  If this obs has been merged with another obs or discarded, skip it.
 435
 436       IF ( obs(first)%info%discard ) THEN
 437          CYCLE obsloop
 438       END IF
 439
 440       total_valid = total_valid + 1
 441
 442       !  Get second obs to compare with first; compare first obs to second obs
 443       !  until next obs does not match.
 444
 445       compare: DO next = current + 1 , num_obs
 446
 447          second = index(next)
 448
 449          ! Sorted by location, so if locations NE, then no chance of any
 450          ! more matches with first.
 451
 452          IF ( .NOT. loc_eq ( obs(first) , obs(second) ) ) THEN
 453             CYCLE obsloop
 454          END IF
 455
 456          !  If this obs has been merged with another obs or discarded, skip it.
 457
 458          IF ( obs(second)%info%discard ) THEN
 459             CYCLE compare
 460          END IF
 461
 462          !  If time fields are not completely identical, they are duplicated
 463
 464 time_difference: &
 465          IF (.NOT. time_eq_old (obs(first)%valid_time, obs(second)%valid_time))&
 466          THEN
 467
 468          total_dups = total_dups + 1
 469          llfirst  = .FALSE.
 470          llsecond = .FALSE.
 471
 472          IF (print_duplicate) THEN
 473
 474          WRITE (UNIT = iunit, FMT = '(/,A)') 'Found duplicated stations:'
 475
 476          WRITE (UNIT = iunit , FMT = '(A,2x,A,A5,A,A23,2F9.3,A,L10)') &
 477         'Station 1 name and ID = ' , &
 478          TRIM (obs(first)%info%platform),       &
 479          TRIM (obs(first)%location%id ) , ' ' , &
 480          TRIM (obs(first)%location%name ) ,     &
 481                obs(first)%location%latitude ,   &
 482                obs(first)%location%longitude, ' ',&
 483                obs (first)%info%is_sound
 484
 485          WRITE (UNIT = iunit , FMT = '(A,2x,A,A5,A,A23,2F9.3,A,L10)') &
 486         'Station 2 name and ID = ' , &
 487          TRIM (obs(second)%info%platform),       &
 488          TRIM (obs(second)%location%id ) , ' ' , &
 489          TRIM (obs(second)%location%name ) ,     &
 490                obs(second)%location%latitude ,   &
 491                obs(second)%location%longitude,' ',&
 492                obs(second)%info%is_sound
 493
 494          ENDIF
 495
 496          ! First we check the nature of the observation: sounding or surface
 497
 498 is_sound:IF (      obs (first)  % info % is_sound .AND.  &
 499               .NOT. obs (second) % info % is_sound) THEN
 500
 501              llfirst  = .TRUE.
 502              llsecond = .FALSE.
 503
 504          ELSE IF (.NOT. obs (first)  % info % is_sound .AND. &
 505                         obs (second) % info % is_sound) THEN
 506
 507              llfirst  = .FALSE.
 508              llsecond = .TRUE.
 509
 510          ELSE is_sound
 511
 512          ! Second we test the time difference between the analysis time and
 513          ! the observations time
 514          ! (negative for before analysis time, positive for after analysis time)
 515
 516            WRITE (time_first, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') &
 517             obs (first) % valid_time % date_char ( 1: 4), &
 518             obs (first) % valid_time % date_char ( 5: 6), &
 519             obs (first) % valid_time % date_char ( 7: 8), &
 520             obs (first) % valid_time % date_char ( 9:10), &
 521             obs (first) % valid_time % date_char (11:12), &
 522             obs (first) % valid_time % date_char (13:14)
 523
 524            WRITE (time_second, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') &
 525             obs (second) % valid_time % date_char ( 1: 4), &
 526             obs (second) % valid_time % date_char ( 5: 6), &
 527             obs (second) % valid_time % date_char ( 7: 8), &
 528             obs (second) % valid_time % date_char ( 9:10), &
 529             obs (second) % valid_time % date_char (11:12), &
 530             obs (second) % valid_time % date_char (13:14)
 531
 532             CALL GETH_IDTS (time_first,  time_analysis, itfirst)
 533             CALL GETH_IDTS (time_second, time_analysis, itsecond)
 534
 535             IF (print_duplicate) THEN
 536
 537             WRITE (UNIT = iunit, FMT = '(2A)') 'Analysis  time = ',time_analysis
 538
 539             IF (itfirst .GE. 0) THEN
 540             WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
 541                                  'Station 1 time = ',time_first, &
 542                                                ' = ta + ',itfirst,'s'
 543             ELSE
 544             WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
 545                                  'Station 1 time = ',time_first, &
 546                                                ' = ta - ',ABS (itfirst),'s'
 547             ENDIF
 548
 549             IF (itsecond .GE. 0) THEN
 550             WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
 551                                  'Station 2 time = ',time_second,&
 552                                                ' = ta + ',itsecond,'s'
 553             ELSE
 554             WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
 555                                  'Station 2 time = ',time_second,&
 556                                                ' = ta - ',ABS (itsecond),'s'
 557             ENDIF
 558
 559             ENDIF
 560
 561             ! Time difference must be different
 562
 563 time_equal: IF (itfirst .EQ. itsecond) THEN
 564                 WRITE (0,'(A)')  ' Internal error:'
 565                 WRITE (0,'(2A)') ' first_time  = ',time_first
 566                 WRITE (0,'(2A)') ' second_time = ',time_second
 567                 STOP ' in check_duplicate_time.F'
 568             ENDIF time_equal
 569
 570 time_different: IF (abs(itfirst) .LT. abs(itsecond)) THEN
 571                 ! first obs is close to analysis time and so retain first
 572                     llfirst  = .TRUE.
 573                     llsecond = .FALSE.
 574                 ELSE IF (abs(itfirst) .GT. abs(itsecond)) THEN
 575                 ! second obs is close to analysis time and so retain second
 576                     llfirst  = .FALSE.
 577                     llsecond = .TRUE.
 578                 ELSE IF (abs(itfirst) .EQ. abs(itsecond)) THEN
 579                ! Two obervations are at exactly time from analysis time but on opposit side
 580                ! Retain the one which is after analysis time
 581                     IF ( itfirst >= 0.)  THEN
 582                     llfirst  = .TRUE.
 583                     llsecond = .FALSE.
 584                     ELSE
 585                     llfirst  = .FALSE.
 586                     llsecond = .TRUE.
 587                     END IF
 588                 ENDIF time_different
 589
 590          END IF is_sound
 591
 592          !  Remove duplicate sounding
 593
 594          IF (remove_duplicate) THEN
 595
 596          IF (llfirst) THEN
 597
 598              IF (print_duplicate) THEN
 599               WRITE (UNIT = iunit, FMT = '(A)') &
 600              'Keep station 1 and reject station 2.'
 601              ENDIF
 602
 603              READ (obs(second) % info % platform (4:6), '(I3)') fm
 604
 605              CALL fm_decoder (fm, platform, &
 606                               synop=nsynops (icor), ship =nshipss (icor), &
 607                               metar=nmetars (icor), pilot=npilots (icor), &
 608                               sound=nsounds (icor), satem=nsatems (icor), &
 609                               satob=nsatobs (icor), airep=naireps (icor), &
 610                               gpspw=ngpspws (icor), gpszd=ngpsztd (icor), &
 611                               gpsrf=ngpsref (icor), gpsep=ngpseph (icor), &
 612                               ssmt1=nssmt1s (icor), bogus=nboguss (icor), &
 613                               ssmt2=nssmt2s (icor), ssmi =nssmis  (icor), &
 614                               tovs =ntovss  (icor), other=nothers (icor), &
 615                               amdar=namdars (icor), qscat=nqscats (icor), &
 616                               profl=nprofls (icor), buoy =nbuoyss (icor), &
 617                               airs =nairss (icor) , tamdar=ntamdar(icor)  )
 618
 619              obs (second)%info%discard  = .true.
 620              obs (first)%info%num_dups  = obs (first)%info%num_dups + 1
 621
 622              NULLIFY (obs(second)%surface )
 623
 624              CYCLE compare
 625
 626
 627          ELSE IF (llsecond) THEN
 628
 629              IF (print_duplicate) THEN
 630               Write (UNIT = iunit, FMT = '(A)') &
 631              'Keep station 2 and reject station 1.'
 632              ENDIF
 633
 634
 635              READ (obs(first) % info % platform (4:6), '(I3)') fm
 636
 637              CALL fm_decoder (fm, platform, &
 638                               synop=nsynops (icor), ship =nshipss (icor), &
 639                               metar=nmetars (icor), pilot=npilots (icor), &
 640                               sound=nsounds (icor), satem=nsatems (icor), &
 641                               satob=nsatobs (icor), airep=naireps (icor), &
 642                               gpspw=ngpspws (icor), gpszd=ngpsztd (icor), &
 643                               gpsrf=ngpsref (icor), gpsep=ngpseph (icor), &
 644                               ssmt1=nssmt1s (icor), bogus=nboguss (icor), &
 645                               ssmt2=nssmt2s (icor), ssmi =nssmis  (icor), &
 646                               tovs =ntovss  (icor), other=nothers (icor), &
 647                               amdar=namdars (icor), qscat=nqscats (icor), &
 648                               profl=nprofls (icor), buoy =nbuoyss (icor), &
 649                               airs =nairss (icor),  tamdar=ntamdar(icor)  )
 650
 651              obs (first)%info%discard    = .true.
 652              obs (second)%info%num_dups  = obs (second)%info%num_dups + 1
 653
 654              NULLIFY ( obs(first)%surface )
 655
 656              CYCLE obsloop
 657
 658          ENDIF
 659
 660          ELSE
 661
 662          !  Order duplicate soundings by time incresing
 663
 664          IF (llfirst) THEN
 665
 666          !  If first observation is before second, do nothing
 667
 668          ELSE IF (llsecond) THEN
 669
 670          !  If second observation is before first, swap
 671
 672               obs_tmp      = obs (second)
 673               obs (second) = obs (first)
 674               obs (first)  = obs_tmp
 675
 676          ENDIF
 677
 678          ENDIF
 679
 680       ENDIF time_difference
 681
 682        !  Free up the space for the observation report that is discarded.
 683        !  Unfortunately, OR NOT!
 684 ! foo
 685 !        CALL dealloc_meas ( obs(second)%surface )
 686 !        NULLIFY ( obs(second)%surface )
 687
 688
 689       END DO compare
 690
 691    END DO obsloop
 692
 693    IF (print_duplicate) CLOSE (iunit)
 694
 695    total_valid = total_valid + 1
 696
 697    WRITE (UNIT = 0 , FMT = '(A,I7,A,/)' ) &
 698   "Found ",total_dups," time duplicate stations that have been removed."
 699
 700 END SUBROUTINE check_duplicate_time
 701
 702 END MODULE module_duplicate