MODULE module_duplicate
!-----------------------------------------------------------------------------!
! Sort observations by location and time,
! Merge space duplicate stations (same type, same location, same time),
! Remove time duplicate stations in time (same type & location, different
! time),
!
! HISTORY:
!
! D. GILL, April 1998
! F. VANDENBERGHE, March 2001
!
! 01/13/2003 - Updated for Profiler obs. S. R. H. Rizvi
!
! 02/04/2003 - Updated for Buoy obs. S. R. H. Rizvi
!
! 02/11/2003 - Reviewed and modified for Profiler
! and Buoy obs. Y.-R. Guo
!
! 08/31/2004 - Corrected check_duplicate_time for retaining obs
! closer to analysis time S. R. H. Rizvi
! 09/02/2004 - Reviewed the above correction, and add the
! modifications for GPS Ref. Y.-R. Guo
! 06/30/2006 - Updated for AIRS retrievals Syed RH Rizvi
!
! 11/09/2006 - add the modifications for GPS Excess Phase Y.-R. Guo
!------------------------------------------------------------------------------
USE module_type
USE module_func
CONTAINS
!-----------------------------------------------------------------------------!
! SUBROUTINE check_duplicate_loc (obs,index,num_obs,total_dups,time_analysis,
! print_duplicate
! SUBROUTINE check_duplicate_time (obs,index,num_obs,total_dups,time_analysis,
! print_duplicate)
!
! -------------------------------------------------------------------------
SUBROUTINE check_duplicate_loc(obs, index, num_obs, total_dups, time_analysis,&
print_duplicate)
! Checks array of reports (obs), which has a sorted index to the reports,
! to determine if any reports are for the same time/location. If so,
! and the data is duplicated exactly in all fields, one is discarded. If
! they are from same time/location and data is not identical, data from
! two reports is merged: 'missing' is replaced by known values; data at
! different levels is merged into one linked list.
USE module_date
USE module_obs_merge
USE module_per_type
IMPLICIT NONE
TYPE ( report ) , INTENT ( INOUT ) , DIMENSION ( : ) :: obs
INTEGER , INTENT ( IN ) , DIMENSION ( : ) :: index
INTEGER , INTENT ( IN ) :: num_obs
INTEGER :: current , &
next , &
first , &
second
INTEGER , INTENT ( OUT ) :: total_dups
! INTEGER , INTENT ( IN ) :: date , &
! time
LOGICAL, INTENT (IN) :: print_duplicate
CHARACTER (LEN = 19) :: time_analysis
INTEGER :: total_valid
INTEGER :: century_year, month, day
INTEGER :: hour, minute, seconds
INTEGER :: date, time
INTEGER :: iunit, io_error
CHARACTER (LEN = 80):: filename
CHARACTER (LEN = 80):: proc_name = "check_duplicate_ob"
CHARACTER (LEN = 160):: error_message
LOGICAL :: fatal, connected
INTEGER :: fma, fmb
CHARACTER (LEN = 40) :: platforma, platformb
INTEGER :: nsynopb, nmetarb, nshipsb, &
nsoundb, npilotb, nairepb, &
nsatemb, nsatobb, ngpspwb, &
nssmt1b, nssmt2b, nssmib, &
ntovsb, notherb, namdarb, &
nqscatb, nproflb, ngpsepb, nbuoysb, &
ngpszdb, ngpsrfb, nbogusb, &
nairsb, ntamdarb
INTEGER :: nsynopa, nmetara, nshipsa, &
nsounda, npilota, nairepa, &
nsatema, nsatoba, ngpspwa, &
nssmt1a, nssmt2a, nssmia, &
ntovsa, nothera, namdara, &
nqscata, nprofla, ngpsepa, nbuoysa, &
ngpszda, ngpsrfa, nbogusa, &
nairsa, ntamdara
INCLUDE 'platform_interface.inc'
!------------------------------------------------------------------------------!
WRITE (0,'(A)') &
'------------------------------------------------------------------------------'
WRITE ( UNIT = 0, FMT = '(A,/)') 'REMOVE DUPLICATE STATIONS BY LOCATION:'
! Open diagnostic file
IF (print_duplicate) THEN
filename = 'obs_duplicate_loc.diag'
iunit = 999
INQUIRE ( UNIT = iunit, OPENED = connected )
IF (connected) CLOSE (iunit)
OPEN (UNIT = iunit , FILE = filename , FORM = 'FORMATTED' , &
ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error )
IF (io_error .NE. 0) THEN
CALL error_handler (proc_name, &
"Unable to open output diagnostic file. ", filename, .TRUE.)
ELSE
WRITE (UNIT = 0, FMT = '(A,A,/)') &
"Diagnostics in file ", TRIM (filename)
ENDIF
ENDIF
! Reset counters
nsynopb = 0; nmetarb = 0; nshipsb = 0;
nsoundb = 0; npilotb = 0; nairepb = 0;
nsatemb = 0; nsatobb = 0; ngpspwb = 0;
nssmt1b = 0; nssmt2b = 0; nssmib = 0;
ntovsb = 0; notherb = 0; namdarb = 0;
nqscatb = 0; nproflb = 0; nbuoysb = 0;
nqscatb = 0; nproflb = 0; nbuoysb = 0;
nairsb =0; nairsa = 0
nsynopa = 0; nmetara = 0; nshipsa = 0;
nsounda = 0; npilota = 0; nairepa = 0;
nsatema = 0; nsatoba = 0; ngpspwa = 0;
nssmt1a = 0; nssmt2a = 0; nssmia = 0;
ntovsa = 0; nothera = 0; namdara = 0;
nqscata = 0; nprofla = 0; nbuoysa = 0;
ngpszda = 0; ngpszdb = 0; nbogusa = 0;
ngpsrfa = 0; ngpsrfb = 0; nbogusb = 0;
ngpsepa = 0; ngpsepb = 0
ntamdara= 0; ntamdarb= 0
! Count obs per type before merging
count_before:&
DO current = 1 , num_obs
first = index(current)
! If this obs has been merged with another obs or discarded, skip it.
IF ( obs(first)%info%discard ) THEN
CYCLE count_before
END IF
! Count obs present per type before merging
READ (obs(first) % info % platform (4:6), '(I3)') fmb
CALL fm_decoder (fmb, platformb, &
synop=nsynopb, ship =nshipsb, metar=nmetarb,&
pilot=npilotb, sound=nsoundb, satem=nsatemb,&
satob=nsatobb, airep=nairepb, gpspw=ngpspwb,&
gpszd=ngpszdb, gpsrf=ngpsrfb, gpsep=ngpsepb,&
bogus=nbogusb, &
ssmt1=nssmt1b, ssmt2=nssmt2b, ssmi =nssmib, &
tovs =ntovsb, other=notherb, amdar=namdarb,&
qscat=nqscatb, profl=nproflb, buoy = nbuoysb,&
airs=nairsb,tamdar=ntamdarb)
ENDDO count_before
! Break analysis time into ccyymmdd and hhmnss
CALL split_date_char (time_analysis, &
century_year, month, day, hour, minute, seconds )
date = century_year * 10000 + month * 100 + day
time = hour * 10000 + minute * 100 + seconds
! Count the total number of duplicate reports.
total_dups = 0
total_valid = 0
! Merge obs
obsloop:&
DO current = 1 , num_obs - 1
first = index(current)
! If this obs has been merged with another obs or discarded, skip it.
IF ( obs(first)%info%discard ) THEN
CYCLE obsloop
END IF
total_valid = total_valid + 1
! Get second obs to compare with first; compare first obs to second obs
! until next obs does not match.
compare: DO next = current + 1 , num_obs
second = index(next)
! Sorted by location, so if locations NE, then no chance of any
! more matches with first.
! foo
! IF (.NOT. (obs(first)%location .EQ. obs(second)%location )) THEN
IF (.NOT. loc_eq (obs(first), obs(second))) THEN
CYCLE obsloop
END IF
! If this obs has been merged with another obs or discarded, skip it.
IF (obs(second)%info%discard) THEN
CYCLE compare
END IF
! If time fields are not completely identical, go to next observation.
! Sort is by location ONLY, not by time; so next+1 may be identical
! even though next has different time.
! This statements modifies the obs date and time
! IF (.NOT. time_eq (obs(first)%valid_time, obs(second)%valid_time, &
! date, time)) THEN
IF (.NOT. time_eq_old (obs(first)%valid_time, obs(second)%valid_time))&
THEN
IF (print_duplicate) THEN
error_message = ' Found multiple times for ' &
// TRIM ( obs(first)%location%id ) // ' ' &
// TRIM ( obs(first)%location%name ) // ', ' &
// TRIM ( obs(first)%valid_time%date_char ) // ' and ' &
// TRIM ( obs(second)%valid_time%date_char ) // '.'
WRITE (UNIT = iunit, FMT = '(A)') TRIM (error_message)
! fatal = .false.
! CALL error_handler (proc_name, error_message , "", fatal)
ENDIF
CYCLE compare
END IF
! Observations are from same location and time, so merge them.
CALL merge_obs ( obs(first) , obs(second), print_duplicate, iunit)
! Mark second of pair as discarded; data is put in 'first'.
! Note that a duplicate has been found by incrementing the counter.
obs(second)%info%discard = .true.
obs(first)%info%num_dups = obs(first)%info%num_dups + 1
total_dups = total_dups + 1
! Free up the space for the observation report that is discarded.
! Unfortunately, OR NOT!
! foo
! CALL dealloc_meas ( obs(second)%surface )
NULLIFY ( obs(second)%surface )
! obs (second)%info%discard = .TRUE.
END DO compare
END DO obsloop
total_valid = total_valid + 1
! Count obs per type after merging
count_after:&
DO current = 1 , num_obs
first = index(current)
! If this obs has been merged with another obs or discarded, skip it.
IF ( obs(first)%info%discard ) THEN
CYCLE count_after
END IF
! Count obs present per type before merging
READ (obs(first) % info % platform (4:6), '(I3)') fma
CALL fm_decoder (fma, platforma, &
synop=nsynopa, ship =nshipsa, metar=nmetara,&
pilot=npilota, sound=nsounda, satem=nsatema,&
satob=nsatoba, airep=nairepa, gpspw=ngpspwa,&
gpszd=ngpszda, gpsrf=ngpsrfa, gpsep=ngpsepa,&
bogus=nbogusa, &
ssmt1=nssmt1a, ssmt2=nssmt2a, ssmi =nssmia, &
tovs =ntovsa, other=nothera, amdar=namdara,&
qscat=nqscata, profl=nprofla, buoy = nbuoysa, &
airs=nairsa, tamdar=ntamdara)
ENDDO count_after
nsynops (icor) = nsynopb - nsynopa
nmetars (icor) = nmetarb - nmetara
nshipss (icor) = nshipsb - nshipsa
nsounds (icor) = nsoundb - nsounda
namdars (icor) = namdarb - namdara
npilots (icor) = npilotb - npilota
naireps (icor) = nairepb - nairepa
ntamdar (icor) = ntamdarb- ntamdara
nsatems (icor) = nsatemb - nsatema
nsatobs (icor) = nsatobb - nsatoba
ngpspws (icor) = ngpspwb - ngpspwa
ngpsztd (icor) = ngpszdb - ngpszda
ngpsref (icor) = ngpsrfb - ngpsrfa
ngpseph (icor) = ngpsepb - ngpsepa
nssmt1s (icor) = nssmt1b - nssmt1a
nssmt2s (icor) = nssmt2b - nssmt2a
nssmis (icor) = nssmib - nssmia
ntovss (icor) = ntovsb - ntovsa
nqscats (icor) = nqscatb - nqscata
nprofls (icor) = nproflb - nprofla
nbuoyss (icor) = nbuoysb - nbuoysa
nboguss (icor) = nbogusb - nbogusa
nairss (icor) = nairsb - nairsa
nothers (icor) = notherb - nothera
WRITE (UNIT = 0 , FMT = '(A,I7,A,/)' ) &
"Found ",total_dups," location duplicate stations that have been merged."
IF (print_duplicate) CLOSE (iunit)
END SUBROUTINE check_duplicate_loc
!
! -----------------------------------------------------------------------
SUBROUTINE check_duplicate_time (obs, index, num_obs, total_dups, time_analysis,print_duplicate)
! Checks array of reports (obs), which has a sorted index to the reports,
! to determine if any reports are for the same location but different time.
! -If both observations are soundings, then the data closest to the analysis
! time is kept
! -If time differences are equal (obs before and after the analysis time),
! then the obs valid after the analysis time is kept.
! -If one is a sounding and the other a surface observation, then the sounding
! is kept whatever the time differences are.
!
USE module_date
USE module_per_type
IMPLICIT NONE
TYPE (report), INTENT (INOUT), DIMENSION (:) :: obs
INTEGER, INTENT (IN), DIMENSION (:) :: index
INTEGER, INTENT (IN) :: num_obs
CHARACTER (LEN = 19), INTENT (INOUT) :: time_analysis
INTEGER, INTENT (OUT) :: total_dups
LOGICAL, INTENT (IN) :: print_duplicate
INTEGER :: total_valid
INTEGER :: current, next, first, second
CHARACTER (LEN = 19) :: time_first, time_second
INTEGER :: itfirst, itsecond
LOGICAL :: llfirst, llsecond
TYPE (report) :: obs_tmp
TYPE (measurement), POINTER :: current_tmp
LOGICAL :: remove_duplicate = .TRUE.
CHARACTER (LEN = 80) :: filename
CHARACTER (LEN = 32 ), PARAMETER :: proc_name = 'check_duplicate_time '
LOGICAL :: connected
INTEGER :: iunit, io_error
INCLUDE 'platform_interface.inc'
!------------------------------------------------------------------------------!
WRITE (0,'(A)') &
'------------------------------------------------------------------------------'
WRITE ( UNIT = 0, FMT = '(A,/)') 'REMOVE DUPLICATE STATIONS BY TIME:'
! Open diagnostic file
IF (print_duplicate) THEN
filename = 'obs_duplicate_time.diag_'//time_analysis
iunit = 999
INQUIRE ( UNIT = iunit, OPENED = connected )
IF (connected) CLOSE (iunit)
OPEN (UNIT = iunit , FILE = filename , FORM = 'FORMATTED' , &
ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error )
IF (io_error .NE. 0) THEN
CALL error_handler (proc_name, &
"Unable to open output diagnostic file. ", filename, .TRUE.)
ELSE
WRITE (UNIT = 0, FMT = '(A,A,/)') &
"Diagnostics in file ", TRIM (filename)
ENDIF
ENDIF
! Count the total number of duplicate reports.
total_valid = 0
total_dups = 0
obsloop: DO current = 1 , num_obs - 1
first = index(current)
! If this obs has been merged with another obs or discarded, skip it.
IF ( obs(first)%info%discard ) THEN
CYCLE obsloop
END IF
total_valid = total_valid + 1
! Get second obs to compare with first; compare first obs to second obs
! until next obs does not match.
compare: DO next = current + 1 , num_obs
second = index(next)
! Sorted by location, so if locations NE, then no chance of any
! more matches with first.
IF ( .NOT. loc_eq ( obs(first) , obs(second) ) ) THEN
CYCLE obsloop
END IF
! If this obs has been merged with another obs or discarded, skip it.
IF ( obs(second)%info%discard ) THEN
CYCLE compare
END IF
! If time fields are not completely identical, they are duplicated
time_difference: &
IF (.NOT. time_eq_old (obs(first)%valid_time, obs(second)%valid_time))&
THEN
total_dups = total_dups + 1
llfirst = .FALSE.
llsecond = .FALSE.
IF (print_duplicate) THEN
WRITE (UNIT = iunit, FMT = '(/,A)') 'Found duplicated stations:'
WRITE (UNIT = iunit , FMT = '(A,2x,A,A5,A,A23,2F9.3,A,L10)') &
'Station 1 name and ID = ' , &
TRIM (obs(first)%info%platform), &
TRIM (obs(first)%location%id ) , ' ' , &
TRIM (obs(first)%location%name ) , &
obs(first)%location%latitude , &
obs(first)%location%longitude, ' ',&
obs (first)%info%is_sound
WRITE (UNIT = iunit , FMT = '(A,2x,A,A5,A,A23,2F9.3,A,L10)') &
'Station 2 name and ID = ' , &
TRIM (obs(second)%info%platform), &
TRIM (obs(second)%location%id ) , ' ' , &
TRIM (obs(second)%location%name ) , &
obs(second)%location%latitude , &
obs(second)%location%longitude,' ',&
obs(second)%info%is_sound
ENDIF
! First we check the nature of the observation: sounding or surface
is_sound:IF ( obs (first) % info % is_sound .AND. &
.NOT. obs (second) % info % is_sound) THEN
llfirst = .TRUE.
llsecond = .FALSE.
ELSE IF (.NOT. obs (first) % info % is_sound .AND. &
obs (second) % info % is_sound) THEN
llfirst = .FALSE.
llsecond = .TRUE.
ELSE is_sound
! Second we test the time difference between the analysis time and
! the observations time
! (negative for before analysis time, positive for after analysis time)
WRITE (time_first, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') &
obs (first) % valid_time % date_char ( 1: 4), &
obs (first) % valid_time % date_char ( 5: 6), &
obs (first) % valid_time % date_char ( 7: 8), &
obs (first) % valid_time % date_char ( 9:10), &
obs (first) % valid_time % date_char (11:12), &
obs (first) % valid_time % date_char (13:14)
WRITE (time_second, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') &
obs (second) % valid_time % date_char ( 1: 4), &
obs (second) % valid_time % date_char ( 5: 6), &
obs (second) % valid_time % date_char ( 7: 8), &
obs (second) % valid_time % date_char ( 9:10), &
obs (second) % valid_time % date_char (11:12), &
obs (second) % valid_time % date_char (13:14)
CALL GETH_IDTS (time_first, time_analysis, itfirst)
CALL GETH_IDTS (time_second, time_analysis, itsecond)
IF (print_duplicate) THEN
WRITE (UNIT = iunit, FMT = '(2A)') 'Analysis time = ',time_analysis
IF (itfirst .GE. 0) THEN
WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
'Station 1 time = ',time_first, &
' = ta + ',itfirst,'s'
ELSE
WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
'Station 1 time = ',time_first, &
' = ta - ',ABS (itfirst),'s'
ENDIF
IF (itsecond .GE. 0) THEN
WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
'Station 2 time = ',time_second,&
' = ta + ',itsecond,'s'
ELSE
WRITE (UNIT = iunit, FMT = '(3A,I6,A)') &
'Station 2 time = ',time_second,&
' = ta - ',ABS (itsecond),'s'
ENDIF
ENDIF
! Time difference must be different
time_equal: IF (itfirst .EQ. itsecond) THEN
WRITE (0,'(A)') ' Internal error:'
WRITE (0,'(2A)') ' first_time = ',time_first
WRITE (0,'(2A)') ' second_time = ',time_second
STOP ' in check_duplicate_time.F'
ENDIF time_equal
time_different: IF (abs(itfirst) .LT. abs(itsecond)) THEN
! first obs is close to analysis time and so retain first
llfirst = .TRUE.
llsecond = .FALSE.
ELSE IF (abs(itfirst) .GT. abs(itsecond)) THEN
! second obs is close to analysis time and so retain second
llfirst = .FALSE.
llsecond = .TRUE.
ELSE IF (abs(itfirst) .EQ. abs(itsecond)) THEN
! Two obervations are at exactly time from analysis time but on opposit side
! Retain the one which is after analysis time
IF ( itfirst >= 0.) THEN
llfirst = .TRUE.
llsecond = .FALSE.
ELSE
llfirst = .FALSE.
llsecond = .TRUE.
END IF
ENDIF time_different
END IF is_sound
! Remove duplicate sounding
IF (remove_duplicate) THEN
IF (llfirst) THEN
IF (print_duplicate) THEN
WRITE (UNIT = iunit, FMT = '(A)') &
'Keep station 1 and reject station 2.'
ENDIF
READ (obs(second) % info % platform (4:6), '(I3)') fm
CALL fm_decoder (fm, platform, &
synop=nsynops (icor), ship =nshipss (icor), &
metar=nmetars (icor), pilot=npilots (icor), &
sound=nsounds (icor), satem=nsatems (icor), &
satob=nsatobs (icor), airep=naireps (icor), &
gpspw=ngpspws (icor), gpszd=ngpsztd (icor), &
gpsrf=ngpsref (icor), gpsep=ngpseph (icor), &
ssmt1=nssmt1s (icor), bogus=nboguss (icor), &
ssmt2=nssmt2s (icor), ssmi =nssmis (icor), &
tovs =ntovss (icor), other=nothers (icor), &
amdar=namdars (icor), qscat=nqscats (icor), &
profl=nprofls (icor), buoy =nbuoyss (icor), &
airs =nairss (icor) , tamdar=ntamdar(icor) )
obs (second)%info%discard = .true.
obs (first)%info%num_dups = obs (first)%info%num_dups + 1
NULLIFY (obs(second)%surface )
CYCLE compare
ELSE IF (llsecond) THEN
IF (print_duplicate) THEN
Write (UNIT = iunit, FMT = '(A)') &
'Keep station 2 and reject station 1.'
ENDIF
READ (obs(first) % info % platform (4:6), '(I3)') fm
CALL fm_decoder (fm, platform, &
synop=nsynops (icor), ship =nshipss (icor), &
metar=nmetars (icor), pilot=npilots (icor), &
sound=nsounds (icor), satem=nsatems (icor), &
satob=nsatobs (icor), airep=naireps (icor), &
gpspw=ngpspws (icor), gpszd=ngpsztd (icor), &
gpsrf=ngpsref (icor), gpsep=ngpseph (icor), &
ssmt1=nssmt1s (icor), bogus=nboguss (icor), &
ssmt2=nssmt2s (icor), ssmi =nssmis (icor), &
tovs =ntovss (icor), other=nothers (icor), &
amdar=namdars (icor), qscat=nqscats (icor), &
profl=nprofls (icor), buoy =nbuoyss (icor), &
airs =nairss (icor), tamdar=ntamdar(icor) )
obs (first)%info%discard = .true.
obs (second)%info%num_dups = obs (second)%info%num_dups + 1
NULLIFY ( obs(first)%surface )
CYCLE obsloop
ENDIF
ELSE
! Order duplicate soundings by time incresing
IF (llfirst) THEN
! If first observation is before second, do nothing
ELSE IF (llsecond) THEN
! If second observation is before first, swap
obs_tmp = obs (second)
obs (second) = obs (first)
obs (first) = obs_tmp
ENDIF
ENDIF
ENDIF time_difference
! Free up the space for the observation report that is discarded.
! Unfortunately, OR NOT!
! foo
! CALL dealloc_meas ( obs(second)%surface )
! NULLIFY ( obs(second)%surface )
END DO compare
END DO obsloop
IF (print_duplicate) CLOSE (iunit)
total_valid = total_valid + 1
WRITE (UNIT = 0 , FMT = '(A,I7,A,/)' ) &
"Found ",total_dups," time duplicate stations that have been removed."
END SUBROUTINE check_duplicate_time
END MODULE module_duplicate