!-------------------------------------- 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 GPSZTDOPTL(PLAT,PLON,PZOBS,PETA,PTT_D,PHU_D,PXP0_D, 1
+ PXPT,PMT,PGZ,PHX_D,PTT,PHU,PXP0,PHX)
#if defined (DOC)
*
***s/r GPSZTDOPTL - tangent linear operator for GPS Zenith Delay ZTD
*
*
*Author : S. Macpherson *ARMA November 2004
* -------------------
*
*Arguments
* PLAT Latitude of observation (deg)
* PLON Longitude of observation (deg)
* PZOBS GPS antenna height ASL (m)
* PETA Trial eta level values
* PTT_D Trial temperature profile (K)
* PHU_D Trial specific humidity profile (kg/kg)
* PXP0_D 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_D Value of H(x) = ZTD (m)
* PTT TL of temperature profile (K)
* PHU TL of humidity profile (kg/kg)
* PXP0 TL of surface pressure
* PHX TL of H(x) = ZTD (m)
*
* Revisions:
* : S. Macpherson *ARMA/MSC 2004
* : S. Macpherson *ARMA/MRD Oct 2007
* - refractivity constants RCK1, RCK2, RCK3 now read from
* NAMGPSGB section of namelist (comgpsgb.cdk)
*
#endif
C
IMPLICIT NONE
C
*implicits
#include "comdim.cdk"
#include "comdimo.cdk"
#include "commvohr.cdk"
#include "comphy.cdk"
#include "pardim.cdk"
#include "comcst.cdk"
#include "comgpsgb.cdk"
*
REAL*8 PLAT
REAL*8 PLON
REAL*8 PZOBS
REAL*8 PETA (NFLEV)
REAL*8 PTT_D (NFLEV), PTT (NFLEV)
REAL*8 PHU_D (NFLEV), PHU (NFLEV)
REAL*8 PGZ (NFLEV)
REAL*8 PXP0_D, PXP0
REAL*8 PXPT
REAL*8 PMT
REAL*8 PHX_D, PHX
C
REAL*8 ZDETA (NFLEV-1)
REAL*8 ZF3 (NFLEV-1), ZF3_D (NFLEV-1)
REAL*8 ZG (NFLEV)
REAL*8 ZZK (NFLEV)
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
REAL*8 ZTTB_D, ZQQB_D, ZINTW_D, ZZHDV_D, ZZWDV_D, ZZTDV_D
REAL*8 ZZTDVC_D, ZDPMDP, ZDP1, ZDP2, ZDPMDT, ZDPMDQ
REAL*8 ZDDWDP, ZDDWDT, ZDDWDQ, ZDP3, ZDDW
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)
C
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 (TRIAL) height (ASL) profiles
C
DO JLEV = 1, NFLEV
IF ( JLEV .EQ. NFLEV ) 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. NFLEV ) IJLEV = NFLEV-1
ZLEVB = ZZK(NFLEV-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, NFLEV-1
ZDETA(JLEV) = PETA(JLEV+1) - PETA(JLEV)
ZTTB_D = (PTT_D(JLEV+1) + PTT_D(JLEV)) * 0.5
ZQQB_D = (PHU_D(JLEV+1) + PHU_D(JLEV)) * 0.5
ZTTB = (PTT (JLEV+1) + PTT (JLEV)) * 0.5
ZQQB = (PHU (JLEV+1) + PHU (JLEV)) * 0.5
C
ZF3(JLEV) = ((PPK2P+(PPK3/ZTTB_D))*(1.0+2.0*DELTA*ZQQB_D))*ZQQB -
+ (PPK3*(ZQQB_D+DELTA*ZQQB_D**2)/ZTTB_D**2) *ZTTB
C
ZF3_D(JLEV) = (ZQQB_D + DELTA*ZQQB_D**2) * (PPK2P+(PPK3/ZTTB_D))
C
END DO
C
C * Vertical integration (trapezoidal rule)
C
ZINTW = 0.0
ZINTW_D = 0.0
DO JLEV = 1, NFLEV-1
ZINTW = ZINTW + ZF3 (JLEV) * ZDETA(JLEV)
ZINTW_D = ZINTW_D + ZF3_D(JLEV) * ZDETA(JLEV)
END DO
C
C ----- ZHD (dry) Part ------
C
ZZHDV_D = (ZCONH / ZFPH) * PXP0_D
ZZHDV = (ZCONH / ZFPH) * PXP0
C
C ----- ZWD (wet) Part ------
C
ZZWDV_D = ZCONW * (PXP0_D - PXPT) * ZINTW_D
ZZWDV = (ZCONW*ZINTW_D)*PXP0 + ZCONW*(PXP0_D-PXPT)*ZINTW
C
C * Compute ZTD = ZHD + ZWD
C
ZZTDV = ZZHDV + ZZWDV
ZZTDVC = ZZTDV
ZZTDV_D = ZZHDV_D + ZZWDV_D
ZZTDVC_D = ZZTDV_D
C
C --------------------------------------------------------------------
C * Correction for DZ
C --------------------------------------------------------------------
C
IF ( ABS(ZDZ) .GT. DZMIN ) THEN
C
C * ------------ STEP 1: GET PRESSURE AT HEIGHT PZOBS ---------------
C
IF ( PZOBS .LE. ZLEVB ) THEN
C
C * CMC EXTRAPOLATION FROM SURFACE TO PZOBS:
C
ZTVSFC = PTT_D(NFLEV) * (1.0 + DELTA*PHU_D(NFLEV))
ZTVOBS = ZTVSFC - PPGAM * ZDZ
ZPMOBS = PXP0_D * (ZTVOBS/ZTVSFC)**ZCON3
C
C * TERMS FOR TL
C
ZDP1 = 1.0 - ((PPGAM*ZDZ)/ZTVSFC)
ZDP2 = PXP0_D * ZCON3 * ZDP1**(ZCON3-1.0)
ZDPMDP = ZDP1**ZCON3
ZDPMDT = ZDP2 * ((PPGAM*ZDZ*(1.0+DELTA*PHU_D(NFLEV))) /
+ ZTVSFC**2)
ZDPMDQ = ZDP2 * (DELTA*PTT_D(NFLEV)*PPGAM*ZDZ) / ZTVSFC**2
C
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,NFLEV-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_D * 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_D * PETA(IK) + PXPT * (1.0 - PETA(IK))
ZPB = PXP0_D * PETA(IK+1) + PXPT * (1.0 - PETA(IK+1))
ZPMOBS = EXP ( (ZDZ2/ZDZT)*LOG(ZPB) + (ZDZ1/ZDZT)*LOG(ZPA) )
ENDIF
C
C * TERMS FOR TL
C
IF (IML .EQ. 1) THEN
ZDPMDP = PETA(IK)
ZDPMDT = 0.0
ZDPMDQ = 0.0
ELSE
ZDP1 = ( (ZDZ2/ZDZT) * PETA(IK+1) ) / ZPB
ZDP2 = ( (ZDZ1/ZDZT) * PETA(IK) ) / ZPA
ZDPMDP = ZPMOBS * ( ZDP1 + ZDP2 )
ZDPMDT = 0.0
ZDPMDQ = 0.0
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_D = (ZCONH / ZFPH) * ZPMOBS
C - Adjust wet delay using Higgins method (Q constant over DZ layer)
ZTMOBS = PTT_D(NFLEV) - (PPGAM * ZDZ)
ZQMOBS = PHU_D(NFLEV)
ZPBAR = (ZPMOBS + PXP0_D) * 0.5
ZTBAR = (ZTMOBS + PTT_D(NFLEV)) * 0.5
ZQBAR = (ZQMOBS + PHU_D(NFLEV)) * 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_D = ZZWDV_D - ZWDCOR
C
C ------------- TL CODE FOR ZTD ADJUSTMENT ------------------------
C
ZZHDV = (ZCONH / ZFPH) *
+ (ZDPMDP*PXP0 + ZDPMDT*PTT(NFLEV) + ZDPMDQ*PHU(NFLEV))
C
C
ZDPMDP = 0.5 * (ZDPMDP + 1.0)
ZDPMDT = 0.5 * ZDPMDT
ZDPMDQ = 0.5 * ZDPMDQ
ZDP1 = 1.0E-06 * ZDZ
ZDDWDP = ZDP1 * ( ( (PPK2P*ZQBAR)/(EPS1*ZTBAR) +
+ (PPK3 *ZQBAR)/(EPS1*ZTBAR**2) ) * ZDPMDP )
C
ZDP2 = -(ZQBAR*ZPBAR) / (EPS1*ZTBAR**2) +
+ (ZQBAR*ZDPMDT) / (EPS1*ZTBAR)
ZDP3 = -(2.0*ZQBAR*ZPBAR) / (EPS1*ZTBAR**3) +
+ (ZQBAR*ZDPMDT) / (EPS1*ZTBAR**2)
ZDDWDT = ZDP1 * (PPK2P*ZDP2 + PPK3*ZDP3)
C
ZDP2 = ZPBAR / (EPS1*ZTBAR) + (ZQBAR*ZDPMDQ) / (EPS1*ZTBAR)
ZDP3 = ZPBAR / (EPS1*ZTBAR**2) +
+ (ZQBAR*ZDPMDQ) / (EPS1*ZTBAR**2)
ZDDWDQ = ZDP1 * (PPK2P*ZDP2 + PPK3*ZDP3)
C
ZDDW = ZDDWDP*PXP0 + ZDDWDT*PTT(NFLEV) + ZDDWDQ*PHU(NFLEV)
ZZWDV = ZZWDV - ZDDW
C
C
C --------------------------------------------------------------------
C
C - Corrected ZTD = new ZHD + adjusted ZWD
ZZTDVC_D = ZZHDV_D + ZZWDV_D
ZZTDVC = ZZHDV + ZZWDV
C
C * --------------- END STEP 2 -------------------------------------
C
ENDIF
C ---------------------------------------------------------------------
C * End DZ correction
C ---------------------------------------------------------------------
C
C Return H(x) and TL H(x)
C
PHX_D = ZZTDVC_D
PHX = ZZTDVC
C
RETURN
END