!-------------------------------------- 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 GPSZTDOP(PLAT,PLON,PZOBS,PETA,PTT,PHU,PXP0,PXPT,PMT, 1
+ PGZ,PHX)
#if defined (DOC)
*
***s/r GPSZTDOP - Forward operator for GPS Zenith Delay ZTD
*
*
*Author : S. Macpherson *ARMA March 2004
* -------------------
*
*Arguments
* PLAT Latitude of observation (deg)
* PLON Longitude of observation (deg)
* PZOBS GPS antenna height ASL (m)
* PETA Trial eta level values
* PTT Trial temperature profile (K)
* PHU Trial specific humidity profile (kg/kg)
* PXP0 Trial surface pressure (Pa)
* PXPT Trial model top pressure (Pa)
* PMT Trial surface elevation ASL (m)
* PGZ Trial geopotential profile (m**2/s**2)
* PHX RETURNS: Value of H(x) = ZTD (m)
*
* Revisions:
* : S. Macpherson *ARMA/MSC Oct 2004
* - added variation of gravity with latitude and height
* by application of Vedel & Huang 2004 formulation
* - reformulated using consistent approach with zenith_delay.doc
* as a reference; ZTD is split into ZHD and ZWD terms
* - added DZ correction (applied to model ZTD) which has been
* removed from sugpsgb.ftn (where it was applied to observation)
* : S. Macpherson *ARMA/MSC Nov 2004
* - modified Psfc interpolation formulation
* : S. Macpherson *ARMA/MRD Oct 2007
* - refractivity constants RCK1, RCK2, RCK3 now read from
* NAMGPSGB section of namelist (comgpsgb.cdk)
*
#endif
C
IMPLICIT NONE
*implicits
#include "comdimo.cdk"
#include "commvohr.cdk"
#include "comphy.cdk"
#include "pardim.cdk"
#include "comcst.cdk"
#include "comgpsgb.cdk"
* Constants found in comphy.cdk
* REAL*8, PARAMETER :: RGASD=287.05
* REAL*8, PARAMETER :: GRAV=9.80616
* REAL*8, PARAMETER :: EPS1=0.621948
* REAL*8, PARAMETER :: DELTA=0.607769
* REAL*8, PARAMETER :: RA=6.37122E+06
* REAL*8, PARAMETER :: PI=3.14159265
*
REAL*8 PLAT
REAL*8 PLON
REAL*8 PZOBS
REAL*8 PETA(NLEVTRL)
REAL*8 PTT (NLEVTRL)
REAL*8 PHU (NLEVTRL)
REAL*8 PGZ (NLEVTRL)
REAL*8 PXP0
REAL*8 PXPT
REAL*8 PMT
REAL*8 PHX
C
REAL*8 ZDETA(NLEVTRL-1)
REAL*8 ZF3 (NLEVTRL-1)
REAL*8 ZG(NLEVTRL)
REAL*8 ZZK(NLEVTRL)
REAL*8 ZTTB
REAL*8 ZQQB
REAL*8 ZCLT, ZGRAV, ZLEVB
REAL*8 ZGRAVM, ZCON, ZCON1, ZCON2
REAL*8 ZFPH, ZCONH, ZCONW, ZINTW, ZZHDV, ZZWDV, ZZTDV, ZDZ
REAL*8 ZTVSFC, ZTVOBS, ZPMOBS, ZCON3, ZPBAR, ZTMOBS, ZQMOBS
REAL*8 ZTBAR, ZQBAR, ZRMEAN, ZWDCOR, ZZTDVC
C
REAL*8 ZPTA, ZPTB, ZDZ2, ZDZ1, ZDZT
REAL*8 ZPA, ZPB
C * Refractivity constants k1, k2', k3 (units = m,Pa,K)
REAL*8 PPK1, PPK2P, PPK3
C
INTEGER JLEV, IK, IML, JK, IJLEV
C
C * Mean column gravity at latitude 45 = PPGM0 (m/s**2)
C * Temperature lapse rate (-dT/dz) = PPGAM (K/m)
REAL*8 PPGM0, PPGAM
DATA PPGM0, PPGAM / 9.784, 0.0065 /
C
C * NAMELIST OPTIONS USED HERE (comgpsgb.cdk, read in PREPROC)
C -----------------------------------------------------------------
C DZMIN Min Abs DZ to do DZ adjustment (m)
C NJLEVP Nth level above the surface level (eta = 1)
C (used for calculating model Psfc at Zobs)
C -----------------------------------------------------------------
C
C * Refractivity Constants (from namelist and in comgpsgb.cdk)
C
PPK1 = RCK1
PPK3 = RCK3
PPK2P = RCK2 - (EPS1*RCK1)
C
C * Height difference DZ between observation and model surface
ZDZ = PZOBS - PMT
C
ZCLT = COS(2.0*(PI/180.)*PLAT)
C
C * Gravity at sea level as a function of latitude (GRAV = G0 = 9.80)
ZGRAV = GRAV * (1.0 - 2.66E-03*ZCLT)
C
C * Mean column gravity as a function of latitude and model sfc height
ZFPH = (1.0 - 2.66E-03*ZCLT - 2.8E-07*PMT)
ZGRAVM = PPGM0 * ZFPH
C
C * Gravity and height (ASL) profiles
C
DO JLEV = 1, NLEVTRL
IF ( JLEV .EQ. NLEVTRL ) THEN
ZZK(JLEV) = PMT
ELSE
ZZK(JLEV) = PGZ(JLEV)/ZGRAV
ENDIF
ZG(JLEV) = ZGRAV * (RA**2/(RA + ZZK(JLEV))**2)
END DO
C
C * If PZOBS is below ZLEVB, use CMC extrapolation from surface
C to get ZPMOBS = Psfc at PZOBS for DZ adjustment (later).
C
IJLEV = NJLEVP
IF ( NJLEVP .GE. NLEVTRL ) IJLEV = NLEVTRL-1
ZLEVB = ZZK(NLEVTRL-IJLEV)
C
C
C ----------------------------------------------------------------
C * Constants
C ----------------------------------------------------------------
ZCON = 1.0E-06 * RGASD
ZCON1 = ZCON * PPK1
ZCON2 = ZCON / EPS1
C ZCON3 = ZGRAV / (RGASD*PPGAM)
ZCON3 = GRAV / (RGASD*PPGAM)
C Constant used to compute the ZHD from Ps (Saastamoinen)
ZCONH = ZCON1/PPGM0
C Value given by Vedel and others (for comparison)
C ZCONH = 2.2768E-05
C Constant for ZWD computation (Vedel)
ZCONW = ZCON2/ZGRAV
C ----------------------------------------------------------------
C
C * Set up terms required for vertical integration of HU, TT terms
C * using trapezoidal rule
C
DO JLEV = 1, NLEVTRL-1
ZDETA(JLEV) = PETA(JLEV+1) - PETA(JLEV)
ZTTB = (PTT(JLEV+1) + PTT(JLEV)) * 0.5
ZQQB = (PHU(JLEV+1) + PHU(JLEV)) * 0.5
ZF3(JLEV) = (ZQQB + DELTA*ZQQB**2) * (PPK2P+(PPK3/ZTTB))
END DO
C
C * Vertical integration (trapezoidal rule)
C
ZINTW = 0.0
DO JLEV = 1, NLEVTRL-1
ZINTW = ZINTW + ZF3(JLEV)*ZDETA(JLEV)
END DO
C
C ----- ZHD (dry) Part ------
C
ZZHDV = (ZCONH / ZFPH) * PXP0
C
C ----- ZWD (wet) Part ------
C
ZZWDV = ZCONW * (PXP0 - PXPT) * ZINTW
C
C * Compute ZTD = ZHD + ZWD
C
ZZTDV = ZZHDV + ZZWDV
ZZTDVC = ZZTDV
C
C --------------------------------------------------------------------
C * Correction for DZ
C --------------------------------------------------------------------
C
IF ( ABS(ZDZ) .GT. DZMIN ) THEN
C
C * ------------ STEP 1: GET PRESSURE AT HEIGHT PZOBS ---------------
IF ( PZOBS .LE. ZLEVB ) THEN
C
C * CMC EXTRAPOLATION FROM SURFACE TO PZOBS:
C
ZTVSFC = PTT(NLEVTRL) * (1.0 + DELTA*PHU(NLEVTRL))
ZTVOBS = ZTVSFC - PPGAM * ZDZ
ZPMOBS = PXP0 * (ZTVOBS/ZTVSFC)**ZCON3
C
ELSE
C
C * INTERPOLATION BETWEEN 2 ETA LEVELS:
C
C * Find eta level above observation height (adpated from routine
C * VOBSLYRS, where result IK is stored in ROBDATA(NCMLYR,JDATA)).
C * If obs height matches height of a model eta level, then
C * set IML=1 (levels match)
C
IK = 1
IML = 0
C
DO JK = 2,NLEVTRL-1
IF( ABS(ZZK(JK)-PZOBS) .LT. 1.0E-06 ) THEN
IK = JK
IML = 1
ELSE
IF( PZOBS .LT. ZZK(JK) ) IK = JK
ENDIF
END DO
C
C * Linear in z interpolation of LOG P
C *
C
IF ( IML .EQ. 1 ) THEN
ZPMOBS = PXP0 * PETA(IK) + PXPT * (1.0 - PETA(IK))
ELSE
ZPTA = ZZK(IK)
ZPTB = ZZK(IK+1)
ZDZ2 = ZPTA - PZOBS
ZDZ1 = PZOBS - ZPTB
ZDZT = ZPTA - ZPTB
ZPA = PXP0 * PETA(IK) + PXPT * (1.0 - PETA(IK))
ZPB = PXP0 * PETA(IK+1) + PXPT * (1.0 - PETA(IK+1))
ZPMOBS = EXP ( (ZDZ2/ZDZT)*LOG(ZPB) + (ZDZ1/ZDZT)*LOG(ZPA) )
ENDIF
C
ENDIF
C * --------------- END STEP 1 -------------------------------------
C
C * --------- STEP 2: ADJUST ZTD FOR DZ ----------------------------
C
C - Calculate new ZHD with new Psfc = ZPMOBS
ZFPH = (1.0 - 2.66E-03*ZCLT - 2.8E-07*PZOBS)
ZZHDV = (ZCONH / ZFPH) * ZPMOBS
C
C - Adjust wet delay using Higgins method (Q constant over DZ layer)
ZTMOBS = PTT(NLEVTRL) - (PPGAM * ZDZ)
ZQMOBS = PHU(NLEVTRL)
ZPBAR = (ZPMOBS + PXP0) * 0.5
ZTBAR = (ZTMOBS + PTT(NLEVTRL)) * 0.5
ZQBAR = (ZQMOBS + PHU(NLEVTRL)) * 0.5
C Mean (wet) refractivity of DZ layer
ZRMEAN = 1.0E-06 * (PPK2P*((ZPBAR*ZQBAR)/(EPS1*ZTBAR)) +
+ PPK3*((ZPBAR*ZQBAR)/(EPS1*ZTBAR**2)))
ZWDCOR = ZRMEAN * ZDZ
ZZWDV = ZZWDV - ZWDCOR
C
C - Corrected ZTD = new ZHD + adjusted ZWD
ZZTDVC = ZZHDV + ZZWDV
C
C * --------------- END STEP 2 -------------------------------------
C
ENDIF
C ---------------------------------------------------------------------
C * End DZ correction
C ---------------------------------------------------------------------
C
C Return H(x)
C
PHX = ZZTDVC
C
RETURN
END