!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE FILTERGPSRO(lcolumnhr,lobsSpaceData) 1,27
#if defined (DOC)
*
***s/r FILTERGPSRO - Filter GPSRO observations
* Guarantee that altitude and observation values are
* within bounds for further processing
*
* For noncompliant GPSRO observations:
* -Set assimilable flag to 0
* -Set bit of cma flag 11 ON
*
*Author : J. M. Aparicio Jan 2008
* Adapted Nov 2012 for both refractivity and bending angle data
* -------------------
*
*Arguments
*
#endif
use EarthConstants_mod
use MathPhysConstants_mod
use obsSpaceData_mod
use columnData_mod
use modgpsro_mod
IMPLICIT NONE
C
type(struct_columnData) :: lcolumnhr
type(struct_obs) :: lobsSpaceData
C
INTEGER INDEX_HEADER, IDATYP, INDEX_BODY
INTEGER JL, IAZM, ISAT, ICLF, iProfile, NH, I
REAL*8 ZMT, Rad, Geo, zLat, zLon, Lat, Lon
REAL*8 HNH1, HSF, HTP, HGP, HMIN, HMAX, ZOBS, ZREF
LOGICAL LLEV, LOBS, LNOM, LSAT
C
WRITE(*,*)'ENTER FILTERGPSRO'
C
C Loop over all header indices of the 'RO' family:
C
call obs_set_current_header_list(lobsSpaceData,'RO')
numGPSROProfiles=0
HEADER: do
index_header = obs_getHeaderIndex(lobsSpaceData)
if (index_header < 0) exit HEADER
C
C * Process only refractivity data (codtyp 169)
C
IDATYP = obs_headElem_i(lobsSpaceData,OBS_ITY,INDEX_HEADER)
IF ( IDATYP .EQ. 169 ) THEN
numGPSROProfiles=numGPSROProfiles+1
C
C * Basic geometric variables of the profile:
C
IAZM = obs_headElem_i(lobsSpaceData,OBS_AZA,INDEX_HEADER)
ISAT = obs_headElem_i(lobsSpaceData,OBS_SAT,INDEX_HEADER)
ICLF = obs_headElem_i(lobsSpaceData,OBS_ROQF,INDEX_HEADER)
Rad = obs_headElem_r(lobsSpaceData,OBS_TRAD,INDEX_HEADER)
Geo = obs_headElem_r(lobsSpaceData,OBS_GEOI,INDEX_HEADER)
LNOM = .NOT.BTEST(ICLF,16-1)
C
C * Check if the satellite is within the accepted set:
C
IF ( NUMGPSSATS .GE. 1 ) THEN
LSAT = .FALSE.
DO I=1,NUMGPSSATS
LSAT=( LSAT .OR. (ISAT.EQ.IGPSSAT(I)) )
ENDDO
ELSE
LSAT = .TRUE.
ENDIF
C
JL = col_getNumLev(LCOLUMNHR,'TH')
ZMT = col_getHeight(lcolumnhr,JL,INDEX_HEADER,'TH')/RG
C
C * Acceptable height limits:
C
JL = 1
HTP = col_getHeight(lcolumnhr,JL,INDEX_HEADER,'TH')/RG
HSF = ZMT+SURFMIN
C
C * Discard low data for METOP/GRAS:
C
IF ( NUMGPSSATS .GE. 1 ) THEN
IF ( ISAT.EQ.3 .OR. ISAT.EQ.4 .OR. ISAT.EQ.5 ) THEN
IF (HSF .LT. 10000.d0) HSF=10000.d0
ENDIF
ENDIF
C
C * Min/max altitudes:
C
IF (HSF .LT. HSFMIN) HSF=HSFMIN
IF (HTP .GT. HTPMAX) HTP=HTPMAX
HMIN=Geo+HSF
HMAX=Geo+HTP
C
C * Loop over all body indices for this index_header:
C * (start at the beginning of the list)
C
call obs_set_current_body_list(lobsSpaceData, INDEX_HEADER)
BODY: do
index_body = obs_getBodyIndex(lobsSpaceData)
if (index_body < 0) exit BODY
C
C * Altitude:
C
HNH1= obs_bodyElem_r(lobsSpaceData,OBS_PPP,INDEX_BODY)
IF (LEVELGPSRO.EQ.1) HNH1=HNH1-Rad
C
C * Observation:
C
ZOBS= obs_bodyElem_r(lobsSpaceData,OBS_VAR,INDEX_BODY)
C
C * Reference order of magnitude value:
C
IF (LEVELGPSRO.EQ.1) THEN
ZREF = 0.025d0*exp(-HNH1/6500.d0)
ELSE
ZREF = 300.d0*exp(-HNH1/6500.d0)
ENDIF
C
C * Positively verify that the altitude is within bounds:
C
LLEV= (HNH1.GT.HMIN) .AND. (HNH1.LT.HMAX)
C
C * Positively verify that the observable is within bounds:
C
LOBS= (ZOBS.GT.(0.3d0*ZREF)) .AND. (ZOBS.LT.(3.d0*ZREF))
C
C * Mark as not assimilable unless all conditions are satisfied:
C
IF ( .NOT.LLEV .OR. .NOT.LOBS .OR. IAZM.LT.0 .OR. .NOT.LNOM .OR. .NOT.LSAT) THEN
call obs_bodySet_i(lobsSpaceData,OBS_ASS,INDEX_BODY, 0)
call obs_bodySet_i(lobsSpaceData,OBS_FLG,INDEX_BODY, IBSET(obs_bodyElem_i(lobsSpaceData,OBS_FLG,INDEX_BODY),11))
ENDIF
ENDDO BODY
ENDIF
ENDDO HEADER
IF (numGPSROProfiles.GT.0) THEN
if(.not.allocated(vGPSRO_IndexPrf)) allocate(vGPSRO_IndexPrf(numGPSROProfiles))
iProfile=0
C
C * Loop over all header indices of the 'RO' family:
C
call obs_set_current_header_list(lobsSpaceData,'RO')
HEADER2: do
index_header = obs_getHeaderIndex(lobsSpaceData)
if (index_header < 0) exit HEADER2
C
C * Process only refractivity data (codtyp 169)
C
IDATYP = obs_headElem_i(lobsSpaceData,OBS_ITY,INDEX_HEADER)
IF ( IDATYP .EQ. 169 ) THEN
iProfile=iProfile+1
vGPSRO_IndexPrf(iProfile)=INDEX_HEADER
zLat = obs_headElem_r(lobsSpaceData,OBS_LAT,INDEX_HEADER)
zLon = obs_headElem_r(lobsSpaceData,OBS_LON,INDEX_HEADER)
Lat = zLat * MPC_DEGREES_PER_RADIAN_R8
Lon = zLon * MPC_DEGREES_PER_RADIAN_R8
ENDIF
ENDDO HEADER2
ENDIF
WRITE(*,*)'EXIT FILTERGPSRO'
RETURN
END SUBROUTINE FILTERGPSRO