! program test ! implicit none ! real lat1,lon1,lat2,lon2,dist,head ! real elev,range,azim ! real sfcrng,height,dhdr ! 10 CONTINUE ! print *, ' Enter height, sfcrange: ' ! read(5,*) height,sfcrng ! IF(height.lt.-1000.) STOP ! CALL beamelv(height,sfcrng,elev,range) ! print *, ' elv, range = ',elev,range ! CALL beamhgt(elev,range,height,sfcrng) ! print *, ' height,sfcrng = ',height,sfcrng ! ! print *, ' Enter lat1,lon1: ' ! read (5,*) lat1,lon1 ! lat1=35. ! lon1=-100. ! print *, ' Enter elev,azim,range ' ! read (5,*) elev,azim,range ! IF(elev.gt.90.) STOP ! CALL beamhgt(elev,range,height,sfcrng) ! print *, ' beam height = ',height ! print *, ' sfc range = ',sfcrng ! CALL dhdrange(elev,range,dhdr) ! print *, ' local elv = ',locelva ! CALL gcircle(lat1,lon1,azim,sfcrng,lat2,lon2) ! print *, ' gate lat,lon = ',lat2,lon2 ! CALL disthead(lat1,lon1,lat2,lon2,head,dist) ! print *, ' distance, heading: ',dist,head ! ! GO TO 10 ! END ! SUBROUTINE beamhgt(elvang,range,height,sfcrng) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Calculate the height of the radar beam and the along- ! ground distance from the radar as a function ! distance along the radar beam (range) and radar ! elevation angle (elvang). ! ! This method assumes dn/dh is constant such that the ! beam curves with a radius of 4/3 of the earth's radius. ! This is from Eq. 2.28 of Doviak and Zrnic', Doppler Radar ! and Weather Observations, 1st Ed. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 06/22/95 ! ! MODIFICATION HISTORY: ! !----------------------------------------------------------------------- ! ! INPUT: ! ! elvang Elevation angle (degrees) of radar beam ! range Distance (meters) along radar beam from radar ! ! OUTPUT: ! height Height (meters) of beam above ground. ! sfcrng Distance (meters) of point along ground from radar. ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE REAL :: elvang REAL :: range REAL :: height REAL :: sfcrng ! DOUBLE PRECISION :: eradius,frthrde,eighthre,fthsq,deg2rad PARAMETER (eradius=6371000., & frthrde=(4.*eradius/3.), & eighthre=(8.*eradius/3.), & fthsq=(frthrde*frthrde), & deg2rad=(3.14592654/180.)) ! DOUBLE PRECISION :: elvrad,hgtdb,rngdb,drange ! elvrad=deg2rad*DBLE(elvang) drange=DBLE(range) hgtdb = SQRT(drange*drange + fthsq + & eighthre*drange*SIN(elvrad)) - & frthrde height=hgtdb rngdb = frthrde * & ASIN (drange*COS(elvrad)/(frthrde + hgtdb) ) sfcrng=rngdb RETURN END SUBROUTINE beamhgt ! SUBROUTINE beamelv(height,sfcrng,elvang,range) 3 ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Calculate the elevation angle (elvang) and the along ! ray-path distance (range) of a radar beam ! crossing through the given height and along-ground ! distance. ! ! This method assumes dn/dh is constant such that the ! beam curves with a radius of 4/3 of the earth's radius. ! This is dervied from Eq. 2.28 of Doviak and Zrnic', ! Doppler Radar and Weather Observations, 1st Ed. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 10/10/95 ! ! MODIFICATION HISTORY: ! !----------------------------------------------------------------------- ! ! INPUT: ! height Height (meters) of beam above ground. ! sfcrng Distance (meters) of point along ground from radar. ! ! OUTPUT ! elvang Elevation angle (degrees) of radar beam ! range Distance (meters) along radar beam from radar ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE REAL :: height REAL :: sfcrng REAL :: elvang REAL :: range ! DOUBLE PRECISION :: eradius,frthrde,eighthre,fthsq,rad2deg PARAMETER (eradius=6371000., & frthrde=(4.*eradius/3.), & eighthre=(8.*eradius/3.), & fthsq=(frthrde*frthrde), & rad2deg=(180./3.14592654)) ! DOUBLE PRECISION :: elvrad,hgtdb,rngdb,drange ! IF(sfcrng > 0.) THEN hgtdb=frthrde+DBLE(height) rngdb=DBLE(sfcrng)/frthrde elvrad = ATAN((hgtdb*COS(rngdb) - frthrde)/(hgtdb * SIN(rngdb))) drange = (hgtdb*SIN(rngdb))/COS(elvrad) elvang=rad2deg*elvrad range=drange ELSE elvang=90. range=height END IF RETURN END SUBROUTINE beamelv ! SUBROUTINE dhdrange(elvang,range,dhdr) 3 ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Calculate the local change in height of the radar ! beam with respect to a change in range. Due to ! curvature of the beam and the earth's surface this is ! generally different what would be calculated from the ! elevation angle measured at the radar. This derivative ! is needed for finding 3-d velocities from radial winds ! and accounting for terminal velocity of precipitation. ! ! This formulation, consistent with subroutine beamhgt, ! assumes a 4/3 earth radius beam curvature. This formula ! is obtained by differentiating Eq 2.28 of Doviak and ! Zrnic', Doppler Radar and Weather Observations, 1st Ed. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 06/22/95 ! ! MODIFICATION HISTORY: ! ! !----------------------------------------------------------------------- ! ! INPUT: ! ! elvang Elevation angle (degrees) of radar beam ! range Distance (meters) along radar beam from radar ! ! OUTPUT: ! dhdr Change in height per change in range (non-dimensional) ! ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE REAL :: range REAL :: elvang REAL :: dhdr ! DOUBLE PRECISION :: eradius,frthrde,eighthre,fthsq,deg2rad PARAMETER (eradius=6371000., & frthrde=(4.*eradius/3.), & eighthre=(8.*eradius/3.), & fthsq=(frthrde*frthrde), & deg2rad=(3.14592654/180.)) ! DOUBLE PRECISION :: sinelv,dhdrdb,drange ! drange=DBLE(range) sinelv=SIN(deg2rad*DBLE(elvang)) dhdrdb = (drange+frthrde*sinelv)/ & SQRT(drange*drange + fthsq + eighthre*drange*sinelv) dhdr = dhdrdb ! RETURN END SUBROUTINE dhdrange ! SUBROUTINE disthead(lat1,lon1,lat2,lon2,headng,dist) 2 ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Given a pair of locations specified in lat,lon on the earth's ! surface find the distance between them and the great circle ! heading from the first point to the second point. Spherical ! geometry is used, which is more than adequate for radar ! and local modelling applications. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 06/22/95 ! ! MODIFICATION HISTORY: ! ! !----------------------------------------------------------------------- ! ! INPUT: ! ! lat1 Latitude (degrees, north positive) of first point ! lon1 Latitude (degrees, east positive) of first point ! lat2 Latitude (degrees, north positive) of second point ! lon2 Latitude (degrees, east positive) of second point ! ! OUTPUT: ! ! headng Heading (degrees, north zero) of great circle path ! at first point. ! dist Distance (meters) between two points along great circle ! great circle arc. ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! ! Arguments ! REAL :: lat1,lon1 REAL :: lat2,lon2 REAL :: headng REAL :: dist ! ! Parameters ! DOUBLE PRECISION :: pi,deg2rad,rad2deg,eradius,one,mone PARAMETER (pi=3.141592654, & deg2rad=(pi/180.), & rad2deg=(180./pi), & eradius=6371000., & ! Earth radius in meters one=1., & mone=-1.) ! ! Misc internal variables ! DOUBLE PRECISION :: alat1,alat2,dlon,arcdst,cosdst,coshd,denom ! ! Find arc length using law of cosines ! ! cos a = cos b cos c + sin b sin c cos A ! cos (1 to 2) = sin(lat1) * sin (lat2) ! +(cos(lat1) * sin (lat2) ! * cos (lon1 - lon2) ! alat1=deg2rad * DBLE(lat1) alat2=deg2rad * DBLE(lat2) dlon=deg2rad*DBLE(lon2-lon1) cosdst = SIN(alat1) * SIN(alat2) + & COS(alat1) * COS(alat2) * COS(dlon) arcdst = ACOS(cosdst) dist = eradius*arcdst ! denom=COS(alat1)*SIN(arcdst) headng=0. IF(ABS(denom) > 1.e-06) THEN coshd=(SIN(alat2) - SIN(alat1)*cosdst) / denom coshd=DMAX1(coshd,mone) coshd=DMIN1(coshd,one) headng=rad2deg*ACOS(coshd) IF( SIN(dlon) < 0 ) headng = 360.-headng ELSE IF( ABS(COS(alat1)) < 1.e-06 .AND. alat1 > 0.) THEN headng=180. END IF ! RETURN END SUBROUTINE disthead ! SUBROUTINE gcircle(lat1,lon1,head,dist,lat2,lon2) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Following a great circle path from a point specified as ! lat,lon on the earth's surface leaving at heading given ! by head for a distance given by dist, give the location ! of the end point. Useful for finding the lat,lon of a ! radar gate. ! !----------------------------------------------------------------------- ! ! AUTHOR: Keith Brewster ! 06/22/95 ! ! MODIFICATION HISTORY: ! ! !----------------------------------------------------------------------- ! ! INPUT: ! lat1 Latitude (degrees, north positive) of first point ! lon1 Latitude (degrees, east positive) of first point ! head Heading (degrees, north zero) of great circle path ! at first point. ! dist Distance (meters) between two points along great circle ! great circle arc. ! ! OUTPUT: ! ! lat2 Latitude (degrees, north positive) of second point ! lon2 Latitude (degrees, east positive) of second point ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! ! Arguments ! REAL :: lat1,lon1 REAL :: head REAL :: dist REAL :: lat2,lon2 ! ! Parameters ! DOUBLE PRECISION :: pi,deg2rad,rad2deg,eradius,one,mone PARAMETER (pi=3.141592654, & deg2rad=(pi/180.), & rad2deg=(180./pi), & eradius=6371000., & ! Earth radius in meters one=1., & mone=-1.) ! ! Misc internal variables ! DOUBLE PRECISION :: alat1,alat2,dlon,arcdst,cosdst,coshd DOUBLE PRECISION :: denom,sinlat2,cosdlon ! alat1=deg2rad*DBLE(lat1) arcdst=DBLE(dist)/eradius cosdst=COS(arcdst) coshd=COS(deg2rad*DBLE(head)) ! sinlat2=coshd*COS(alat1)*SIN(arcdst) + SIN(alat1)*cosdst sinlat2=DMAX1(sinlat2,mone) sinlat2=DMIN1(sinlat2,one) alat2=ASIN(sinlat2) lat2=rad2deg*alat2 ! denom=COS(alat1)*COS(alat2) IF(denom /= 0.) THEN cosdlon=(cosdst - SIN(alat1)*sinlat2)/(COS(alat1)*COS(alat2)) cosdlon=DMAX1(cosdlon,mone) cosdlon=DMIN1(cosdlon,one) dlon=rad2deg*ACOS(cosdlon) IF(SIN(deg2rad*head) < 0.) dlon=-dlon lon2=lon1+dlon ELSE lon2=lon1 END IF RETURN END SUBROUTINE gcircle ! SUBROUTINE rmvterm(nvar_radin,mx_rad,nz_rdr,mx_colrad, & 1,3 latrad,lonrad,elvrad, & latradc,lonradc,irad,nlevrad,hgtradc,obsrad, & ncolrad,istatus) ! IMPLICIT NONE ! !----------------------------------------------------------------------- ! ! Removes the precipitation terminal velocity from ! the observed radial velocity. From Zeigler, 1978. ! ! An empirical formula based on the reflectivity is ! used to estimate the terminal velocity. ! ! For simplicity, atmospheric density is approxmated ! by a standard atmosphere, rho(z)=rhonot exp(-z/h0) ! !----------------------------------------------------------------------- ! INTEGER :: mx_rad,nz_rdr,mx_colrad,nvar_radin ! !----------------------------------------------------------------------- ! ! Radar site variables ! !----------------------------------------------------------------------- ! REAL :: latrad(mx_rad),lonrad(mx_rad) REAL :: elvrad(mx_rad) ! !----------------------------------------------------------------------- ! ! Radar observation variables ! !----------------------------------------------------------------------- ! INTEGER :: irad(mx_colrad) INTEGER :: nlevrad(mx_colrad) REAL :: latradc(mx_colrad),lonradc(mx_colrad) REAL :: hgtradc(nz_rdr,mx_colrad) REAL :: obsrad(nvar_radin,nz_rdr,mx_colrad) INTEGER :: ncolrad INTEGER :: istatus ! ! Parameters ! REAL :: deg2rad PARAMETER (deg2rad=(3.14592654/180.)) ! REAL :: zfrez,zice,rho0,h0,denom,dbzmin,dbzmax,vrmax,refmax PARAMETER (zfrez=3000., & zice=8000., & rho0=1.2250, & h0=7000., & denom=(1./(zice-zfrez)), & dbzmin=10., & dbzmax=100., & vrmax=80., & refmax=80.) ! INTEGER :: icol,klev REAL :: azm,rng,refz,rhofact,s1,s2,vt,dz,eleva,bmrng,dhdr ! IF(dbzmin > 30.) PRINT *, ' Warning Terminal Velocity Removal Disabled' ! DO icol=1,ncolrad IF(irad(icol) > 0) THEN CALL disthead(latrad(irad(icol)),lonrad(irad(icol)), & latradc(icol),lonradc(icol),azm,rng) DO klev=1,nlevrad(icol) IF(obsrad(1,klev,icol) > dbzmin .AND. & ABS(obsrad(1,klev,icol)) < dbzmax .AND. & ABS(obsrad(2,klev,icol)) < vrmax) THEN refz=10.**(0.1*obsrad(1,klev,icol)) rhofact=EXP(0.4*hgtradc(klev,icol)/h0) IF(hgtradc(klev,icol) < zfrez) THEN vt=2.6*(refz**0.107)*rhofact ELSE IF(hgtradc(klev,icol) < zice) THEN s1=(zice-hgtradc(klev,icol))*denom s2=2.*(hgtradc(klev,icol)-zfrez)*denom vt=s1*2.6*(refz**0.107)*rhofact + s2 ELSE vt=2.0 END IF dz=hgtradc(klev,icol)-elvrad(irad(icol)) CALL beamelv(dz,rng,eleva,bmrng) CALL dhdrange(eleva,bmrng,dhdr) obsrad(2,klev,icol)=obsrad(2,klev,icol) + & vt*dhdr END IF END DO END IF END DO istatus=1 RETURN END SUBROUTINE rmvterm !