! -*- F90 -*-
!
! Refractivity operator, with derivatives.
!
! Josep M. Aparicio, 2003-2012.
! ARMA/ASTD
! Environment Canada
!
module modgps08refop 4,10
use modgps00base
, only : i4, dp, ngpssize
use modgps01ctmath , only : m_pi
use modgps03diff
use modgps04profile , only : gpsprofile
use modgps07geostruct, only : gpsbvf
implicit none
contains
!
! GPSRO Refractivity operator
! On input:
! -hv an array of height values
! -prf local profile
! On output:
! -refopv an array of refractivity values (with derivatives)
!
pure subroutine gpsrefopv(hv, nval, prf, refopv) 4
real(dp) , intent(in) :: hv(:)
integer(i4) , intent(in) :: nval
type(gpsprofile) , intent(in) :: prf
type(gpsdiff) , intent(out):: refopv(:)
integer(i4) :: iSize, i, ngpslev
integer(i4) :: j, jloc
real(dp) :: h
type(gpsdiff) :: dz
type(gpsdiff) :: dzm
type(gpsdiff) :: dzp
ngpslev=prf%ngpslev
iSize = size(hv)
if (nval < iSize) iSize=nval
!
! Given a height
!
do i = 1, iSize
h = hv(i)
!
! Search where it is located
!
if (h > prf%gst(1)%Var) then
jloc = 1
endif
do j=1, ngpslev-1
if ((h <= prf%gst(j)%Var) .and. (h > prf%gst(j+1)%Var)) then
jloc = j
exit
endif
enddo
if (h <= prf%gst(ngpslev)%Var) then
jloc = ngpslev-1
endif
!
! Linear-log interpolation
!
dz = prf%gst(jloc) - prf%gst(jloc+1)
dzm = h - prf%gst(jloc+1)
dzp = prf%gst(jloc) - h
refopv(i) = exp( (dzm * log(prf%rst(jloc)) + dzp * log(prf%rst(jloc+1))) / dz )
enddo
end subroutine gpsrefopv
subroutine gpshgtopv(pr, prf, hgtopv)
real(dp) , intent(in) :: pr
type(gpsprofile) :: prf
type(gpsdiff) , intent(out):: hgtopv
integer(i4) :: j, jloc, ngpslev
real(dp) :: p
type(gpsdiff) :: vpm
type(gpsdiff) :: vpp
type(gpsdiff) :: dpr
type(gpsdiff) :: dxm
type(gpsdiff) :: dxp
type(gpsdiff) :: Hm
type(gpsdiff) :: Hp
type(gpsdiff) :: H
ngpslev=prf%ngpslev
!
! Given a pressure
!
p = pr
!
! Search where it is located
!
if (p < prf%pst(1)%Var) then
jloc = 1
endif
do j=1, ngpslev-1
if ((p >= prf%pst(j)%Var) .and. (p < prf%pst(j+1)%Var)) then
jloc = j
exit
endif
enddo
if (p >= prf%pst(ngpslev)%Var) then
jloc = ngpslev-1
endif
!
! Find properties in that band
!
vpm = log(prf%pst(jloc))
vpp = log(prf%pst(jloc+1))
dpr = vpp-vpm
dxm = (vpp-log(p)) / dpr
dxp = (log(p)-vpm) / dpr
Hm = prf%gst(jloc)
Hp = prf%gst(jloc+1)
H = dxm * Hm + dxp * Hp
hgtopv = H
end subroutine gpshgtopv
subroutine gpstemopv(pr, nval, prf, temopv)
real(dp) , intent(in) :: pr(:)
integer(i4) , intent(in) :: nval
type(gpsprofile) :: prf
type(gpsdiff) , intent(out):: temopv(:)
integer :: iSize, ngpslev
integer(i4) :: i, j, jloc
real(dp) :: p
type(gpsdiff) :: vpm
type(gpsdiff) :: vpp
type(gpsdiff) :: dpr
type(gpsdiff) :: dxm
type(gpsdiff) :: dxp
type(gpsdiff) :: Tm
type(gpsdiff) :: Tp
type(gpsdiff) :: T
ngpslev=prf%ngpslev
iSize = size(pr)
if (nval < iSize) iSize=nval
do i = 1, iSize
!
! Given a pressure
!
p = pr(i)
!
! Search where it is located
!
if (p < prf%pst(1)%Var) then
jloc = 1
endif
do j=1, ngpslev-1
if ((p >= prf%pst(j)%Var) .and. (p < prf%pst(j+1)%Var)) then
jloc = j
exit
endif
enddo
if (p >= prf%pst(ngpslev)%Var) then
jloc = ngpslev-1
endif
!
! Find properties in that band
!
vpm = log(prf%pst(jloc))
vpp = log(prf%pst(jloc+1))
dpr = vpp-vpm
dxm = (vpp-log(p)) / dpr
dxp = (log(p)-vpm) / dpr
Tm = prf%tst(jloc)
Tp = prf%tst(jloc+1)
T = dxm * Tm + dxp * Tp
temopv(i) = T
enddo
end subroutine gpstemopv
subroutine gpswmropv(pr, prf, wmropv)
real(dp) , intent(in) :: pr(:)
type(gpsprofile) :: prf
type(gpsdiff) , intent(out):: wmropv(:)
integer :: iSize, ngpslev
integer(i4) :: i, j, jloc
real(dp) :: p
type(gpsdiff) :: vpm
type(gpsdiff) :: vpp
type(gpsdiff) :: dpr
type(gpsdiff) :: dxm
type(gpsdiff) :: dxp
type(gpsdiff) :: Rm
type(gpsdiff) :: Rp
type(gpsdiff) :: R
ngpslev=prf%ngpslev
iSize = size(pr)
do i = 1, iSize
!
! Given a pressure
!
p = pr(i)
!
! Search where it is located
!
if (p < prf%pst(1)%Var) then
jloc = 1
endif
do j=1, ngpslev-1
if ((p >= prf%pst(j)%Var) .and. (p < prf%pst(j+1)%Var)) then
jloc = j
exit
endif
enddo
if (p >= prf%pst(ngpslev)%Var) then
jloc = ngpslev-1
endif
!
! Find properties in that band
!
vpm = log(prf%pst(jloc))
vpp = log(prf%pst(jloc+1))
dpr = vpp-vpm
dxm = (vpp-log(p)) / dpr
dxp = (log(p)-vpm) / dpr
Rm = prf%qst(jloc)
Rp = prf%qst(jloc+1)
R = dxm * Rm + dxp * Rp
wmropv(i) = R * 28.97_dp / 18.01528_dp
enddo
end subroutine gpswmropv
subroutine gpsbvfopv(hv, nval, prf, bvfopv),2
real(dp) , intent(in) :: hv(:)
integer(i4) , intent(in) :: nval
type(gpsprofile) :: prf
type(gpsdiff) , intent(out):: bvfopv(:)
integer(i4) :: iSize, i, ngpslev
integer(i4) :: j, jloc
real(dp) :: h
type(gpsdiff) :: bvf(ngpssize)
type(gpsdiff) :: gpm
type(gpsdiff) :: gpp
type(gpsdiff) :: dz
type(gpsdiff) :: dxm
type(gpsdiff) :: dxp
type(gpsdiff) :: BVm
type(gpsdiff) :: BVp
call gpsbvf(prf,bvf)
ngpslev=prf%ngpslev
iSize = size(hv)
if (nval < iSize) iSize=nval
!
! Given a height
!
do i = 1, iSize
h = hv(i)
!
! Search where it is located
!
if (h > prf%gst(1)%Var) then
jloc = 1
endif
do j=1, ngpslev-1
if ((h <= prf%gst(j)%Var) .and. (h > prf%gst(j+1)%Var)) then
jloc = j
exit
endif
enddo
if (h <= prf%gst(ngpslev)%Var) then
jloc = ngpslev-1
endif
!
! Find properties in that band
!
gpm = prf%gst(jloc)
gpp = prf%gst(jloc+1)
dz = gpm - gpp
dxm = (h-gpp) / dz
dxp = (gpm-h) / dz
BVm = bvf(jloc)
BVp = bvf(jloc+1)
bvfopv (i) = dxm * BVm + dxp * BVp
enddo
end subroutine gpsbvfopv
end module modgps08refop