Geo-Inverse-0.09/0000755000175000017500000000000014761176736013137 5ustar mdavismdavisGeo-Inverse-0.09/Changes0000644000175000017500000000124114760772563014427 0ustar mdavismdavisRevision history for Perl module Geo-Inverse 0.09 2025-03-01 - Fixed prereqs fixes #2 0.08 2025-02-28 - Added error check for undef 0.07 2022-11-29 - Added GitHub repository 0.06 2011-10-31 - Added tests pod.t kwalitee.t changes.t pod-coverage.t - Updated to pass tests - Imported new constructor from Package::New 0.05 2007-04-07 - Added inverse.for to distribution 0.04 2007-04-06 - Added scalar context to inverse function should be 100% backward compatable 0.03 2006-12-08 - Merged set and ellipsoid methods - Updated build requirment versions 0.02 2006-12-03 - Imported Geo::Constants Geo::Functions 0.01 2006-10-30 - Original version Geo-Inverse-0.09/MANIFEST0000644000175000017500000000051714761176736014273 0ustar mdavismdavisChanges LICENSE Makefile.PL MANIFEST README.md CONTRIBUTING.md lib/Geo/Inverse.pm t/000_load.t t/001_qgis_compare.t doc/inverse.for doc/Makefile perl-Geo-Inverse.spec META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Geo-Inverse-0.09/doc/0000755000175000017500000000000014761176736013704 5ustar mdavismdavisGeo-Inverse-0.09/doc/Makefile0000644000175000017500000000011514341517621015323 0ustar mdavismdavisNAME = inverse SRC = $(NAME).for build: $(SRC) gfortran -o $(NAME) $(SRC) Geo-Inverse-0.09/doc/inverse.for0000644000175000017500000013721614051753665016073 0ustar mdavismdaviscb::inverse c program inverse c c********1*********2*********3*********4*********5*********6*********7** c c name: inverse c version: 200208.19 c author: stephen j. frakes c purpose: to compute a geodetic inverse c and then display output information c c input parameters: c ----------------- c c output parameters: c ------------------ c c local variables and constants: c ------------------------------ c answer user prompt response c b semiminor axis polar (in meters) c baz azimuth back (in radians) c buff input char buffer array c dd,dm,ds temporary values for degrees, minutes, seconds c dlon temporary value for difference in longitude (radians) c dmt,d_mt char constants for meter units c edist ellipsoid distance (in meters) c elips ellipsoid choice c esq eccentricity squared for reference ellipsoid c faz azimuth forward (in radians) c filout output file name c finv reciprocal flattening c hem hemisphere flag for lat & lon entry c ierror error condition flag with d,m,s conversion c lgh length of buff() array c option user prompt response c r1,r2 temporary variables c ss temporary variable c tol tolerance for conversion of seconds c c name1 name of station one c ld1,lm1,sl1 latitude sta one - degrees,minutes,seconds c ald1,alm1,sl1 latitude sta one - degrees,minutes,seconds c lat1sn latitude sta one - sign (+/- 1) c d_ns1 latitude sta one - char ('N','S') c lod1,lom1,slo1 longitude sta one - degrees,minutes,seconds c alod1,alom1,slo1 longitude sta one - degrees,minutes,seconds c lon1sn longitude sta one - sign (+/- 1) c d_ew1 longitude sta one - char ('E','W') c iaz1,maz1,saz1 forward azimuth - degrees,minutes,seconds c isign1 forward azimuth - flag (+/- 1) c glat1,glon1 station one - (lat & lon in radians ) c p1,e1 standpoint one - (lat & lon in radians ) c c name2 name of station two c ld2,lm2,sl2 latitude sta two - degrees,minutes,seconds c ald2,alm2,sl2 latitude sta two - degrees,minutes,seconds c lat2sn latitude sta two - sign (+/- 1) c d_ns2 latitude sta two - char ('N','S') c lod2,lom2,slo2 longitude sta two - degrees,minutes,seconds c alod2,alom2,slo2 longitude sta one - degrees,minutes,seconds c lon2sn longitude sta two - sign (+/- 1) c d_ew2 longitude sta two - char ('E','W') c iaz2,maz2,saz2 back azimuth - degrees,minutes,seconds c isign2 back azimuth - flag (+/- 1) c glat2,glon2 station two - (lat & lon in radians ) c p2,e2 forepoint two - (lat & lon in radians ) c c global variables and constants: c ------------------------------- c a semimajor axis equatorial (in meters) c f flattening c pi constant 3.14159.... c rad constant 180.0/pi c c this module called by: n/a c c this module calls: elipss, getrad, inver1, todmsp c gethem, trim, bufdms, gvalr8, gvali4, fixdms, gpnhri c datan, write, read, dabs, open, stop c c include files used: n/a c c common blocks used: const, elipsoid c c references: see comments within subroutines c c comments: c c********1*********2*********3*********4*********5*********6*********7** c::modification history c::1990mm.dd, sjf, creation of program c::199412.15, bmt, creation of program on viper c::200203.08, crs, modified by c.schwarz to correct spelling of Clarke c::200207.15, rws, modified i/o & standardized program documentation c:: added subs trim, bufdms, gethem, gvali4, gvalr8 c::200207.23, rws, replaced sub inver1 with gpnarc, gpnloa, gpnhri c::200208.15, rws, fixed an error in bufdms c:: - renamed ellips to elipss "common error" with dirct2 c:: - added FAZ & BAZ to printed output c::200208.19, rws, added more error flags for web interface code c:: - added logical nowebb c::200208.xx, sjf, program version number 2.0 c********1*********2*********3*********4*********5*********6*********7** ce::inverse c implicit double precision (a-h, o-z) implicit integer (i-n) c logical nowebb c character*1 answer,option,dmt,buff(50),hem character*6 d_ns1, d_ew1, d_ns2, d_ew2, d_mt character*30 filout,name1,name2,elips c integer*4 ierror integer*4 lgh c common/const/pi,rad common/elipsoid/a,f c c ms_unix 0 = web version c 1 = ms_dos or unix version c parameter ( ms_unix = 0 ) c pi = 4.d0*datan(1.d0) rad = 180.d0/pi dmt = 'm' d_mt = 'Meters' c if( ms_unix.eq.1 )then nowebb = .true. else nowebb = .false. endif c 1 do 2 i=1,25 write(*,*) ' ' 2 continue c 5 write(*,*) ' Program Inverse - Version 2.0 ' write(*,*) ' ' write(*,*) ' Ellipsoid options : ' write(*,*) ' ' write(*,*) ' 1) GRS80 / WGS84 (NAD83) ' write(*,*) ' 2) Clarke 1866 (NAD27) ' write(*,*) ' 3) Any other ellipsoid ' write(*,*) ' ' write(*,*) ' Enter choice : ' read(*,10) option 10 format(a1) c if(option.eq.'1') then a=6378137.d0 f=1.d0/298.25722210088d0 elips='GRS80 / WGS84 (NAD83)' elseif(option.eq.'2') then a=6378206.4d0 f=1.d0/294.9786982138d0 elips='Clarke 1866 (NAD27)' elseif(option.eq.'3') then call elipss (elips) else write(*,*) ' Enter 1, 2, or 3 ! Try again --' goto 5 endif c esq = f*(2.0d0-f) c write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' c 15 write(*,*) ' Enter First Station ' write(*,16) 16 format(18x,'(Separate D,M,S by blanks or commas)') write(*,*) 'hDD MM SS.sssss Latitude : (h default = N )' 11 format(50a1) c 22 hem='N' read(*,11) buff call trim (buff,lgh,hem) call bufdms (buff,lgh,hem,dd,dm,ds,ierror) c if( ierror.eq.0 )then irlat1 = 0 else irlat1 = 1 write(*,*) ' Invalid Latitude ... Please re-enter it ' write(*,*) ' ' if( nowebb )then goto 22 endif endif c ald1 = dd alm1 = dm sl1 = ds c if( hem.eq.'N' ) then lat1sn = +1 else lat1sn = -1 endif c write(*,*) 'hDDD MM SS.sssss Longitude : (h default = W )' c 23 hem='W' read(*,11) buff call trim (buff,lgh,hem) call bufdms (buff,lgh,hem,dd,dm,ds,ierror) c if( ierror.eq.0 )then irlon1 = 0 else irlon1 = 1 write(*,*) ' Invalid Longitude ... Please re-enter it ' write(*,*) ' ' if( nowebb )then goto 23 endif endif c alod1 = dd alom1 = dm slo1 = ds c if( hem.eq.'E' ) then lon1sn = +1 else lon1sn = -1 endif c call getrad(ald1, alm1, sl1, lat1sn, glat1) call getrad(alod1,alom1,slo1,lon1sn, glon1) c write(*,*) ' ' write(*,*) ' ' c 20 write(*,*) ' Enter Second Station ' write(*,16) write(*,*) 'hDD MM SS.sssss Latitude : (h default = N )' c 24 hem='N' read(*,11) buff call trim (buff,lgh,hem) call bufdms (buff,lgh,hem,dd,dm,ds,ierror) c if( ierror.eq.0 )then irlat2 = 0 else irlat2 = 1 write(*,*) ' Invalid Latitude ... Please re-enter it ' write(*,*) ' ' if( nowebb )then goto 24 endif endif c ald2 = dd alm2 = dm sl2 = ds c if( hem.eq.'N' ) then lat2sn = +1 else lat2sn = -1 endif c write(*,*) 'hDDD MM SS.sssss Longitude : (h default = W )' c 25 hem='W' read(*,11) buff call trim (buff,lgh,hem) call bufdms (buff,lgh,hem,dd,dm,ds,ierror) c if( ierror.eq.0 )then irlon2 = 0 else irlon2 = 1 write(*,*) ' Invalid Longitude ... Please re-enter it ' write(*,*) ' ' if( nowebb )then goto 25 endif endif c alod2 = dd alom2 = dm slo2 = ds c if( hem.eq.'E' )then lon2sn = +1 else lon2sn = -1 endif c call getrad(ald2, alm2, sl2, lat2sn, glat2) call getrad(alod2,alom2,slo2,lon2sn, glon2) c p1 = glat1 e1 = glon1 p2 = glat2 e2 = glon2 c if( e1.lt.0.0d0 )then e1 = e1+2.0d0*pi endif if( e2.lt.0.0d0 )then e2 = e2+2.0d0*pi endif c c compute the geodetic inverse c c ************************************************************ c * replaced subroutine inver1 with gpnhri c * c * call inver1 (glat1,glon1,glat2,glon2,faz,baz,edist) c * c ************************************************************ c call gpnhri (a,f,esq,pi,p1,e1,p2,e2,faz,baz,edist) c c check for a non distance ... p1,e1 & p2,e2 equal zero ? c if( edist.lt.0.00005d0 )then faz = 0.0d0 baz = 0.0d0 endif c c set the tolerance (in seconds) for the azimuth conversion c tol = 0.00005d0 c call todmsp(faz,iaz1,maz1,saz1,isign1) if(isign1.lt.0) then iaz1=359-iaz1 maz1=59-maz1 saz1=60.d0-saz1 endif call fixdms ( iaz1, maz1, saz1, tol ) c call todmsp(baz,iaz2,maz2,saz2,isign2) if(isign2.lt.0) then iaz2=359-iaz2 maz2=59-maz2 saz2=60.d0-saz2 endif call fixdms ( iaz2, maz2, saz2, tol ) c call todmsp(glat1, ld1, lm1, sl1, lat1sn) call todmsp(glon1, lod1, lom1, slo1, lon1sn) call todmsp(glat2, ld2, lm2, sl2, lat2sn) call todmsp(glon2, lod2, lom2, slo2, lon2sn) c call hem_ns ( lat1sn, d_ns1 ) call hem_ew ( lon1sn, d_ew1 ) call hem_ns ( lat2sn, d_ns2 ) call hem_ew ( lon2sn, d_ew2 ) c write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' write(*,49) elips 49 format(' Ellipsoid : ',a30) finv=1.d0/f b=a*(1.d0-f) write(*,50) a,b,finv 50 format(' Equatorial axis, a = ',f15.4,/, * ' Polar axis, b = ',f15.4,/, * ' Inverse flattening, 1/f = ',f16.11) c 18 format(' LAT = ',i3,1x,i2,1x,f8.5,1x,a6) 19 format(' LON = ',i3,1x,i2,1x,f8.5,1x,a6) c write(*,*) ' ' write(*,*) ' First Station : ' write(*,*) ' ---------------- ' write(*,18) ld1, lm1, sl1, d_ns1 write(*,19) lod1,lom1,slo1,d_ew1 c write(*,*) ' ' write(*,*) ' Second Station : ' write(*,*) ' ---------------- ' write(*,18) ld2, lm2, sl2, d_ns2 write(*,19) lod2,lom2,slo2,d_ew2 c 32 format(' Ellipsoidal distance S = ',f14.4,1x,a1) 34 format(' Forward azimuth FAZ = ',i3,1x,i2,1x,f7.4, 1 ' From North') 35 format(' Back azimuth BAZ = ',i3,1x,i2,1x,f7.4, 1 ' From North') c write(*,*) ' ' write(*,34) iaz1,maz1,saz1 write(*,35) iaz2,maz2,saz2 write(*,32) edist,dmt write(*,*) ' ' write(*,*) ' Do you want to save this output into a file (y/n)?' read(*,10) answer c if( answer.eq.'Y'.or.answer.eq.'y' )then 39 write(*,*) ' Enter the output filename : ' read(*,40) filout 40 format(a30) open(3,file=filout,status='new',err=99) goto 98 c 99 write(*,*) ' File already exists, try again.' go to 39 c 98 continue write(3,*) ' ' write(3,49) elips finv=1.d0/f b=a*(1.d0-f) write(3,50) a,b,finv write(*,*) ' Enter the First Station name : ' read(*,40) name1 write(*,*) ' Enter the Second Station name : ' read(*,40) name2 c 41 format(' First Station : ',a30) 42 format(' Second Station : ',a30) 84 format(' Error: First Station ... Invalid Latitude ') 85 format(' Error: First Station ... Invalid Longitude ') 86 format(' Error: Second Station ... Invalid Latitude ') 87 format(' Error: Second Station ... Invalid Longitude ') 88 format(1x,65(1h*)) 91 format(' DD(0-89) MM(0-59) SS(0-59.999...) ') 92 format(' DDD(0-359) MM(0-59) SS(0-59.999...) ') c write(3,*) ' ' write(3,41) name1 write(3,*) ' ---------------- ' if( irlat1.eq.0 )then write(3,18) ld1, lm1, sl1, d_ns1 else write(3,88) write(3,84) write(3,91) write(3,88) endif c if( irlon1.eq.0 )then write(3,19) lod1,lom1,slo1,d_ew1 else write(3,88) write(3,85) write(3,92) write(3,88) endif c write(3,*) ' ' write(3,42) name2 write(3,*) ' ---------------- ' c if( irlat2.eq.0 )then write(3,18) ld2, lm2, sl2, d_ns2 else write(3,88) write(3,86) write(3,91) write(3,88) endif c if( irlon2.eq.0 )then write(3,19) lod2,lom2,slo2,d_ew2 else write(3,88) write(3,87) write(3,92) write(3,88) endif c write(3,*) ' ' write(3,34) iaz1,maz1,saz1 write(3,35) iaz2,maz2,saz2 write(3,32) edist,dmt write(3,*) ' ' endif c 80 write(*,*) ' ' write(*,*) ' ' write(*,*) ' ' write(*,*) ' 1) Another inverse, different ellipsoid.' write(*,*) ' 2) Same ellipsoid, two new stations.' write(*,*) ' 3) Same ellipsoid, same First Station.' write(*,*) ' 4) Done.' write(*,*) ' ' write(*,*) ' Enter choice : ' read(*,10) answer c if( answer.eq.'1' )then goto 1 elseif( answer.eq.'2' )then goto 15 elseif( answer.eq.'3' )then goto 20 else write(*,*) ' Thats all, folks!' endif c stop end subroutine bufdms (buff,lgh,hem,dd,dm,ds,ierror) implicit double precision (a-h, o-z) implicit integer (i-n) c logical done,flag c character*1 buff(*),abuf(21) character*1 ch character*1 hem integer*4 ll,lgh integer*4 i4,id,im,is,icond,ierror real*8 x(5) c c set the "error flag" c ierror = 0 icond = 0 c c set defaults for dd,dm,ds c dd = 0.0d0 dm = 0.0d0 ds = 0.0d0 c c set default limits for "hem" flag c if( hem.eq.'N' .or. hem.eq.'S' )then ddmax = 90.0d0 elseif( hem.eq.'E' .or. hem.eq.'W' )then ddmax = 360.0d0 elseif( hem.eq.'A' )then ddmax = 360.0d0 elseif( hem.eq.'Z' )then ddmax = 180.0d0 elseif( hem.eq.'*' )then ddmax = 0.0d0 ierror = 1 else ddmax = 360.0d0 endif c do 1 i=1,5 x(i) = 0.0d0 1 continue c icolon = 0 ipoint = 0 icount = 0 flag = .true. jlgh = lgh c do 2 i=1,jlgh if( buff(i).eq.':' )then icolon = icolon+1 endif if( buff(i).eq.'.' )then ipoint = ipoint+1 flag = .false. endif if( flag )then icount = icount+1 endif 2 continue c if( ipoint.eq.1 .and. icolon.eq.0 )then c c load temp buffer c do 3 i=1,jlgh abuf(i) = buff(i) 3 continue abuf(jlgh+1) = '$' ll = jlgh c call gvalr8 (abuf,ll,r8,icond) c if( icount.ge.5 )then c c value is a packed decimal of ==> DDMMSS.sssss c ss = r8/10000.0d0 id = idint( ss ) c r8 = r8-10000.0d0*dble(float(id)) ss = r8/100.0d0 im = idint( ss ) c r8 = r8-100.0d0*dble(float(im)) else c c value is a decimal of ==> .xx X.xxx X. c id = idint( r8 ) r8 = (r8-id)*60.0d0 im = idint( r8 ) r8 = (r8-im)*60.0d0 endif c c account for rounding error c is = idnint( r8*1.0d5 ) if( is.ge.6000000 )then r8 = 0.0d0 im = im+1 endif c if( im.ge.60 )then im = 0 id = id+1 endif c dd = dble( float( id ) ) dm = dble( float( im ) ) ds = r8 else c c buff() value is a d,m,s of ==> NN:NN:XX.xxx c k = 0 next = 1 done = .false. ie = jlgh c do 100 j=1,5 ib = next do 90 i=ib,ie ch = buff(i) last = i if( i.eq.jlgh .or. ch.eq.':' )then if( i.eq.jlgh )then done = .true. endif if( ch.eq.':' )then last = i-1 endif goto 91 endif 90 continue goto 98 c 91 ipoint = 0 ik = 0 do 92 i=next,last ik = ik+1 ch = buff(i) if( ch.eq.'.' )then ipoint = ipoint+1 endif abuf(ik) = buff(i) 92 continue abuf(ik+1) = '$' c ll = ik if( ipoint.eq.0 )then call gvali4 (abuf,ll,i4,icond) r8 = dble(float( i4 )) else call gvalr8 (abuf,ll,r8,icond) endif c k = k+1 x(k) = r8 c 98 if( done )then goto 101 endif c next = last 99 next = next+1 if( buff(next).eq.':' )then goto 99 endif 100 continue c c load dd,dm,ds c 101 if( k.ge.1 )then dd = x(1) endif c if( k.ge.2 )then dm = x(2) endif c if( k.ge.3 )then ds = x(3) endif endif c if( dd.gt.ddmax .or. 1 dm.ge.60.0d0 .or. 1 ds.ge.60.0d0 )then ierror = 1 dd = 0.0d0 dm = 0.0d0 ds = 0.0d0 endif c if( icond.ne.0 )then ierror = 1 endif c return end subroutine elipss (elips) implicit double precision(a-h,o-z) character*1 answer character*30 elips common/elipsoid/a,f write(*,*) ' Other Ellipsoids.' write(*,*) ' -----------------' write(*,*) ' ' write(*,*) ' A) Airy 1858' write(*,*) ' B) Airy Modified' write(*,*) ' C) Australian National' write(*,*) ' D) Bessel 1841' write(*,*) ' E) Clarke 1880' write(*,*) ' F) Everest 1830' write(*,*) ' G) Everest Modified' write(*,*) ' H) Fisher 1960' write(*,*) ' I) Fisher 1968' write(*,*) ' J) Hough 1956' write(*,*) ' K) International (Hayford)' write(*,*) ' L) Krassovsky 1938' write(*,*) ' M) NWL-9D (WGS 66)' write(*,*) ' N) South American 1969' write(*,*) ' O) Soviet Geod. System 1985' write(*,*) ' P) WGS 72' write(*,*) ' Q-Z) User defined.' write(*,*) ' ' write(*,*) ' Enter choice : ' read(*,10) answer 10 format(a1) c if(answer.eq.'A'.or.answer.eq.'a') then a=6377563.396d0 f=1.d0/299.3249646d0 elips='Airy 1858' elseif(answer.eq.'B'.or.answer.eq.'b') then a=6377340.189d0 f=1.d0/299.3249646d0 elips='Airy Modified' elseif(answer.eq.'C'.or.answer.eq.'c') then a=6378160.d0 f=1.d0/298.25d0 elips='Australian National' elseif(answer.eq.'D'.or.answer.eq.'d') then a=6377397.155d0 f=1.d0/299.1528128d0 elips='Bessel 1841' elseif(answer.eq.'E'.or.answer.eq.'e') then a=6378249.145d0 f=1.d0/293.465d0 elips='Clarke 1880' elseif(answer.eq.'F'.or.answer.eq.'f') then a=6377276.345d0 f=1.d0/300.8017d0 elips='Everest 1830' elseif(answer.eq.'G'.or.answer.eq.'g') then a=6377304.063d0 f=1.d0/300.8017d0 elips='Everest Modified' elseif(answer.eq.'H'.or.answer.eq.'h') then a=6378166.d0 f=1.d0/298.3d0 elips='Fisher 1960' elseif(answer.eq.'I'.or.answer.eq.'i') then a=6378150.d0 f=1.d0/298.3d0 elips='Fisher 1968' elseif(answer.eq.'J'.or.answer.eq.'j') then a=6378270.d0 f=1.d0/297.d0 elips='Hough 1956' elseif(answer.eq.'K'.or.answer.eq.'k') then a=6378388.d0 f=1.d0/297.d0 elips='International (Hayford)' elseif(answer.eq.'L'.or.answer.eq.'l') then a=6378245.d0 f=1.d0/298.3d0 elips='Krassovsky 1938' elseif(answer.eq.'M'.or.answer.eq.'m') then a=6378145.d0 f=1.d0/298.25d0 elips='NWL-9D (WGS 66)' elseif(answer.eq.'N'.or.answer.eq.'n') then a=6378160.d0 f=1.d0/298.25d0 elips='South American 1969' elseif(answer.eq.'O'.or.answer.eq.'o') then a=6378136.d0 f=1.d0/298.257d0 elips='Soviet Geod. System 1985' elseif(answer.eq.'P'.or.answer.eq.'p') then a=6378135.d0 f=1.d0/298.26d0 elips='WGS 72' else elips = 'User defined.' c write(*,*) ' Enter Equatorial axis, a : ' read(*,*) a a = dabs(a) c write(*,*) ' Enter either Polar axis, b or ' write(*,*) ' Reciprocal flattening, 1/f : ' read(*,*) ss ss = dabs(ss) c f = 0.0d0 if( 200.0d0.le.ss .and. ss.le.310.0d0 )then f = 1.d0/ss elseif( 6000000.0d0.lt.ss .and. ss.lt.a )then f = (a-ss)/a else elips = 'Error: default GRS80 used.' a = 6378137.0d0 f = 1.0d0/298.25722210088d0 endif endif c return end subroutine fixdms (ideg, min, sec, tol ) c implicit double precision (a-h, o-z) implicit integer (i-n) c c test for seconds near 60.0-tol c if( sec.ge.( 60.0d0-tol ) )then sec = 0.0d0 min = min+1 endif c c test for minutes near 60 c if( min.ge.60 )then min = 0 ideg = ideg+1 endif c c test for degrees near 360 c if( ideg.ge.360 )then ideg = 0 endif c return end subroutine hem_ns ( lat_sn, hem ) implicit integer (i-n) character*6 hem c if( lat_sn.eq.1 ) then hem = 'North ' else hem = 'South ' endif c return end subroutine hem_ew ( lon_sn, hem ) implicit integer (i-n) character*6 hem c if( lon_sn.eq.1 ) then hem = 'East ' else hem = 'West ' endif c return end subroutine getrad(d,m,sec,isign,val) *** comvert deg, min, sec to radians implicit double precision(a-h,j-z) common/const/pi,rad val=(d+m/60.d0+sec/3600.d0)/rad val=dble(isign)*val return end CB::GPNARC C SUBROUTINE GPNARC (AMAX,FLAT,ESQ,PI,P1,P2,ARC) C C********1*********2*********3*********4*********5*********6*********7* C C NAME: GPNARC C VERSION: 200005.26 C WRITTEN BY: ROBERT (Sid) SAFFORD C PURPOSE: SUBROUTINE TO COMPUTE THE LENGTH OF A MERIDIONAL ARC C BETWEEN TWO LATITUDES C C INPUT PARAMETERS: C ----------------- C AMAX SEMI-MAJOR AXIS OF REFERENCE ELLIPSOID C FLAT FLATTENING (0.0033528 ... ) C ESQ ECCENTRICITY SQUARED FOR REFERENCE ELLIPSOID C PI 3.14159... C P1 LAT STATION 1 C P2 LAT STATION 2 C C OUTPUT PARAMETERS: C ------------------ C ARC GEODETIC DISTANCE C C LOCAL VARIABLES AND CONSTANTS: C ------------------------------ C GLOBAL VARIABLES AND CONSTANTS: C ------------------------------- C C MODULE CALLED BY: GENERAL C C THIS MODULE CALLS: C LLIBFORE/ OPEN, CLOSE, READ, WRITE, INQUIRE C DABS, DBLE, FLOAT, IABS, CHAR, ICHAR C C INCLUDE FILES USED: C COMMON BLOCKS USED: C C REFERENCES: Microsoft FORTRAN 4.10 Optimizing Compiler, 1988 C MS-DOS Operating System C COMMENTS: C********1*********2*********3*********4*********5*********6*********7* C::MODIFICATION HISTORY C::197507.05, RWS, VER 00 TENCOL RELEASED FOR FIELD USE C::198311.20, RWS, VER 01 MTEN RELEASED TO FIELD C::198411.26, RWS, VER 07 MTEN2 RELEASED TO FIELD C::1985xx.xx, RWS, CODE CREATED C::198506.10, RWS, WRK ENHANCEMENTS RELEASED TO FIELD C::198509.01, RWS, VER 11 MTEN3 RELEASED TO FIELD C::198512.18, RWS, CODE MODIFIED FOR MTEN3 C::198708.10, RWS, CODE MODIFIED TO USE NEW MTEN4 GPN RECORD FORMAT C::199112.31, RWS, VER 20 MTEN4 RELEASED TO FIELD C::200001.13, RWS, VER 21 MTEN4 RELEASED TO FIELD C::200005.26, RWS, CODE RESTRUCTURED & DOCUMENTATION ADDED C::200012.31, RWS, VER 23 MTEN5 RELEASED C********1*********2*********3*********4*********5*********6*********7* CE::GPNARC C --------------------------- C M T E N (VERSION 3) C M T E N (VERSION 5.23) C --------------------------- C IMPLICIT REAL*8 (A-H,O-Z) C LOGICAL FLAG C DATA TT/5.0D-15/ C C CHECK FOR A 90 DEGREE LOOKUP C FLAG = .FALSE. C S1 = DABS(P1) S2 = DABS(P2) C IF( (PI/2.0D0-TT).LT.S2 .AND. S2.LT.(PI/2.0D0+TT) )THEN FLAG = .TRUE. ENDIF C IF( S1.GT.TT )THEN FLAG = .FALSE. ENDIF C DA = (P2-P1) S1 = 0.0D0 S2 = 0.0D0 C C COMPUTE THE LENGTH OF A MERIDIONAL ARC BETWEEN TWO LATITUDES C E2 = ESQ E4 = E2*E2 E6 = E4*E2 E8 = E6*E2 EX = E8*E2 C T1 = E2*(003.0D0/4.0D0) T2 = E4*(015.0D0/64.0D0) T3 = E6*(035.0D0/512.0D0) T4 = E8*(315.0D0/16384.0D0) T5 = EX*(693.0D0/131072.0D0) C A = 1.0D0+T1+3.0D0*T2+10.0D0*T3+35.0D0*T4+126.0D0*T5 C IF( FLAG )THEN GOTO 1 ENDIF C B = T1+4.0D0*T2+15.0D0*T3+56.0D0*T4+210.0D0*T5 C = T2+06.0D0*T3+28.0D0*T4+120.0D0*T5 D = T3+08.0D0*T4+045.0D0*T5 E = T4+010.0D0*T5 F = T5 C DB = DSIN(P2*2.0D0)-DSIN(P1*2.0D0) DC = DSIN(P2*4.0D0)-DSIN(P1*4.0D0) DD = DSIN(P2*6.0D0)-DSIN(P1*6.0D0) DE = DSIN(P2*8.0D0)-DSIN(P1*8.0D0) DF = DSIN(P2*10.0D0)-DSIN(P1*10.0D0) C C COMPUTE THE S2 PART OF THE SERIES EXPANSION C S2 = -DB*B/2.0D0+DC*C/4.0D0-DD*D/6.0D0+DE*E/8.0D0-DF*F/10.0D0 C C COMPUTE THE S1 PART OF THE SERIES EXPANSION C 1 S1 = DA*A C C COMPUTE THE ARC LENGTH C ARC = AMAX*(1.0D0-ESQ)*(S1+S2) C RETURN END cb::gpnhri c subroutine gpnhri (a,f,esq,pi,p1,e1,p2,e2,az1,az2,s) c c********1*********2*********3*********4*********5*********6*********7* c c name: gpnhri c version: 200208.09 c written by: robert (sid) safford c purpose: subroutine to compute helmert rainsford inverse problem c c solution of the geodetic inverse problem after t. vincenty c modified rainsford's method with helmert's elliptical terms c effective in any azimuth and at any distance short of antipocal c from/to stations must not be the geographic pole. c parameter a is the semi-major axis of the reference ellipsoid c finv=1/f is the inverse flattening of the reference ellipsoid c latitudes and longitudes in radians positive north and west c forward and back azimuths returned in radians clockwise from south c geodesic distance s returned in units of semi-major axis a c programmed for ibm 360-195 09/23/75 c c note - note - note - c 1. do not use for meridional arcs and be careful on the equator. c 2. azimuths are from north(+) clockwise and c 3. longitudes are positive east(+) c c input parameters: c ----------------- c a semi-major axis of reference ellipsoid meters c f flattening (0.0033528...) c esq eccentricity squared c pi 3.14159... c p1 lat station 1 radians c e1 lon station 1 radians c p2 lat station 2 radians c e2 lon station 2 radians c c output parameters: c ------------------ c az1 azi at sta 1 -> sta 2 radians c az2 azi at sta 2 -> sta 1 radians c s geodetic dist between sta(s) 1 & 2 meters c c local variables and constants: c ------------------------------ c aa constant from subroutine gpnloa c alimit equatorial arc distance along the equator (radians) c arc meridional arc distance latitude p1 to p2 (in meters) c az1 azimuth forward (in radians) c az2 azimuth back (in radians) c bb constant from subroutine gpnloa c dlon temporary value for difference in longitude (radians) c equ equatorial distance (in meters) c r1,r2 temporary variables c s ellipsoid distance (in meters) c sms equatorial - geodesic distance (S - s) "Sms" c ss temporary variable c tol0 tolerance for checking computation value c tol1 tolerance for checking a real zero value c tol2 tolerance for close to zero value c twopi two times constant pi c c global variables and constants: c ------------------------------- c c module called by: general c c this module calls: gpnarc, gpnloa c llibfore/ dsin, dcos, dsqrt, dabs, datan2, write c c include files used: c common blocks used: c c references: microsoft fortran 4.10 optimizing compiler, 1988 c ms-dos operating system c comments: c********1*********2*********3*********4*********5*********6*********7* c::modification history c::197507.05, rws, ver 00 tencol released for field use c::198311.20, rws, ver 01 mten released to field c::198411.26, rws, ver 07 mten2 released to field c::198506.10, rws, wrk enhancements released to field c::198507.22, rws, code modified for mten3 c::198509.01, rws, ver 11 mten3 released to field c::198708.10, rws, code modified to use new mten4 gpn record format c::199112.31, rws, ver 20 mten4 released to field c::200001.13, rws, ver 21 mten4 released to field c::200005.26, rws, code restructured & documentation added c::200012.31, rws, ver 23 mten5 released c::200104.09, rws, code added to calblin program c::200208.09, rws, code added subroutines gpnarc & gpnloa c********1*********2*********3*********4*********5*********6*********7* ce::gpnhri c ------------------------------- c m t e n (version 3) c (version 4.22) c (version 5.23) c ------------------------------- c implicit real*8 (a-h,o-z) c data tol0 /5.0d-15/ data tol1 /5.0d-14/ data tol2 /7.0d-03/ c twopi = 2.0d0*pi c c test the longitude difference with tol1 c tol1 is approximately 0.000000001 arc seconds c ss = e2-e1 if( dabs(ss).lt.tol1 )then e2 = e2+tol1 write(*,*) ' longitudal difference is near zero ' c r2 = p2 r1 = p1 call gpnarc ( a, f, esq, pi, r1, r2, arc ) s = dabs( arc ) c if( p2.gt.p1 )then az1 = 0.0d0 az2 = pi else az1 = pi az2 = 0.0d0 endif return endif c c test for longitude over 180 degrees c dlon = e2-e1 c if( dlon.ge.0.0d0 )then if( pi.le.dlon .and. dlon.lt.twopi )then dlon = dlon-twopi endif else ss = dabs(dlon) if( pi.le.ss .and. ss.lt.twopi )then dlon = dlon+twopi endif endif c ss = dabs( dlon ) if( ss.gt.pi )then c:: write(*,*) ' ' c:: write(*,*) ' Longitude difference over 180 degrees ' c:: write(*,*) ' Turn it around ' ss = twopi-ss endif c c compute the limit in longitude (alimit), it is equal c to twice the distance from the equator to the pole, c as measured along the equator (east/ewst) c alimit = pi*(1.0d0-f) c c test for anti-nodal difference c if( ss.ge.alimit )then r1 = dabs(p1) r2 = dabs(p2) c c latitudes r1 & r2 are not near the equator c if( r1.gt.tol2 .and. r2.gt.tol2 )then goto 60 endif c c longitude difference is greater than lift-off point c now check to see if "both" r1 & r2 are on equator c if( r1.lt.tol1 .and. r2.gt.tol2 )then goto 60 endif if( r2.lt.tol1 .and. r1.gt.tol2 )then goto 60 endif c c check for either r1 or r2 just off the equator but < tol2 c if( r1.gt.tol1. or. r2.gt.tol1 )then az1 = 0.0d0 az2 = 0.0d0 s = 0.0d0 return endif c c compute the azimuth to anti-nodal point c c:: write(*,*) ' ' c:: write(*,*) ' Longitude difference beyond lift-off point ' c:: write(*,*) ' ' c call gpnloa (a,f,esq,pi,dlon,az1,az2,aa,bb,sms) c c compute the equatorial distance & geodetic c equ = a*dabs(dlon) s = equ-sms return endif c 60 continue c f0 = (1.0d0-f) b = a*f0 epsq = esq/(1.0d0-esq) f2 = f*f f3 = f*f2 f4 = f*f3 c c the longitude difference c dlon = e2-e1 ab = dlon kount = 0 c c the reduced latitudes c u1 = f0*dsin(p1)/dcos(p1) u2 = f0*dsin(p2)/dcos(p2) c u1 = datan(u1) u2 = datan(u2) c su1 = dsin(u1) cu1 = dcos(u1) c su2 = dsin(u2) cu2 = dcos(u2) c c counter for the iteration operation c 1 kount = kount+1 c clon = dcos(ab) slon = dsin(ab) c csig = su1*su2+cu1*cu2*clon ssig = dsqrt((slon*cu2)**2+(su2*cu1-su1*cu2*clon)**2) c sig = datan2(ssig,csig) sinalf=cu1*cu2*slon/ssig c w = (1.0d0-sinalf*sinalf) t4 = w*w t6 = w*t4 c c the coefficients of type a c ao = f-f2*(1.0d0+f+f2)*w/4.0d0+3.0d0*f3*(1.0d0+ 1 9.0d0*f/4.0d0)*t4/16.0d0-25.0d0*f4*t6/128.0d0 a2 = f2*(1.0d0+f+f2)*w/4.0d0-f3*(1.0d0+9.0d0*f/4.0d0)*t4/4.0d0+ 1 75.0d0*f4*t6/256.0d0 a4 = f3*(1.0d0+9.0d0*f/4.0d0)*t4/32.0d0-15.0d0*f4*t6/256.0d0 a6 = 5.0d0*f4*t6/768.0d0 c c the multiple angle functions c qo = 0.0d0 if( w.gt.tol0 )then qo = -2.0d0*su1*su2/w endif c q2 = csig+qo q4 = 2.0d0*q2*q2-1.0d0 q6 = q2*(4.0d0*q2*q2-3.0d0) r2 = 2.0d0*ssig*csig r3 = ssig*(3.0d0-4.0d0*ssig*ssig) c c the longitude difference c s = sinalf*(ao*sig+a2*ssig*q2+a4*r2*q4+a6*r3*q6) xz = dlon+s c xy = dabs(xz-ab) ab = dlon+s c if( xy.lt.0.5d-13 )then goto 4 endif c if( kount.le.7 )then goto 1 endif c c the coefficients of type b c 4 z = epsq*w c bo = 1.0d0+z*(1.0d0/4.0d0+z*(-3.0d0/64.0d0+z*(5.0d0/256.0d0- 1 z*175.0d0/16384.0d0))) b2 = z*(-1.0d0/4.0d0+z*(1.0d0/16.0d0+z*(-15.0d0/512.0d0+ 1 z*35.0d0/2048.0d0))) b4 = z*z*(-1.0d0/128.0d0+z*(3.0d0/512.0d0-z*35.0d0/8192.0d0)) b6 = z*z*z*(-1.0d0/1536.0d0+z*5.0d0/6144.0d0) c c the distance in meters c s = b*(bo*sig+b2*ssig*q2+b4*r2*q4+b6*r3*q6) c c first compute the az1 & az2 for along the equator c if( dlon.gt.pi )then dlon = (dlon-2.0d0*pi) endif c if( dabs(dlon).gt.pi )then dlon = (dlon+2.0d0*pi) endif c az1 = pi/2.0d0 if( dlon.lt.0.0d0 )then az1 = 3.0d0*az1 endif c az2 = az1+pi if( az2.gt.2.0d0*pi )then az2 = az2-2.0d0*pi endif c c now compute the az1 & az2 for latitudes not on the equator c if( .not.(dabs(su1).lt.tol0 .and. dabs(su2).lt.tol0) )then tana1 = slon*cu2/(su2*cu1-clon*su1*cu2) tana2 = slon*cu1/(su1*cu2-clon*su2*cu1) sina1 = sinalf/cu1 sina2 = -sinalf/cu2 c c azimuths from north,longitudes positive east c az1 = datan2(sina1,sina1/tana1) az2 = pi-datan2(sina2,sina2/tana2) endif c if( az1.lt.0.0d0 )then az1 = az1+2.0d0*pi endif c if( az2.lt.0.0d0 )then az2 = az2+2.0d0*pi endif c return end CB::GPNLOA C SUBROUTINE GPNLOA (AMAX,FLAT,ESQ,PI,DL,AZ1,AZ2,AO,BO,SMS) C C********1*********2*********3*********4*********5*********6*********7* C C NAME: GPNLOA C VERSION: 200005.26 C WRITTEN BY: ROBERT (Sid) SAFFORD C PURPOSE: SUBROUTINE TO COMPUTE THE LIFF-OFF-AZIMUTH CONSTANTS C C INPUT PARAMETERS: C ----------------- C AMAX SEMI-MAJOR AXIS OF REFERENCE ELLIPSOID C FLAT FLATTENING (0.0033528 ... ) C ESQ ECCENTRICITY SQUARED FOR REFERENCE ELLIPSOID C PI 3.14159... C DL LON DIFFERENCE C AZ1 AZI AT STA 1 -> STA 2 C C OUTPUT PARAMETERS: C ------------------ C AZ2 AZ2 AT STA 2 -> STA 1 C AO CONST C BO CONST C SMS DISTANCE ... EQUATORIAL - GEODESIC (S - s) "SMS" C C LOCAL VARIABLES AND CONSTANTS: C ------------------------------ C GLOBAL VARIABLES AND CONSTANTS: C ------------------------------- C C MODULE CALLED BY: GENERAL C C THIS MODULE CALLS: C LLIBFORE/ DSIN, DCOS, DABS, DASIN C C INCLUDE FILES USED: C COMMON BLOCKS USED: C C REFERENCES: Microsoft FORTRAN 4.10 Optimizing Compiler, 1988 C MS-DOS Operating System C COMMENTS: C********1*********2*********3*********4*********5*********6*********7* C::MODIFICATION HISTORY C::1985xx.xx, RWS, CODE CREATED C::198506.10, RWS, WRK ENHANCEMENTS RELEASED TO FIELD C::198509.01, RWS, VER 11 MTEN3 RELEASED TO FIELD C::198512.18, RWS, CODE MODIFIED FOR MTEN3 C::198708.10, RWS, CODE MODIFIED TO USE NEW MTEN4 GPN RECORD FORMAT C::199112.31, RWS, VER 20 MTEN4 RELEASED TO FIELD C::200001.13, RWS, VER 21 MTEN4 RELEASED TO FIELD C::200005.26, RWS, CODE RESTRUCTURED & DOCUMENTATION ADDED C::200012.31, RWS, VER 23 MTEN5 RELEASED C********1*********2*********3*********4*********5*********6*********7* CE::GPNLOA C --------------------------- C M T E N (VERSION 3) C (VERSION 4.22) C (VERSION 5.23) C --------------------------- C IMPLICIT REAL*8 (A-H,O-Z) C DATA TT/5.0D-13/ C DLON = DABS(DL) CONS = (PI-DLON)/(PI*FLAT) F = FLAT C C COMPUTE AN APPROXIMATE AZ C AZ = DASIN(CONS) C T1 = 1.0D0 T2 = (-1.0D0/4.0D0)*F*(1.0D0+F+F*F) T4 = 3.0D0/16.0D0*F*F*(1.0D0+(9.0D0/4.0D0)*F) T6 = (-25.0D0/128.0D0)*F*F*F C ITER = 0 1 ITER = ITER+1 S = DCOS(AZ) C2 = S*S C C COMPUTE NEW AO C AO = T1 + T2*C2 + T4*C2*C2 + T6*C2*C2*C2 CS = CONS/AO S = DASIN(CS) IF( DABS(S-AZ).LT.TT )THEN GOTO 2 ENDIF C AZ = S IF( ITER.LE.6 )THEN GOTO 1 ENDIF C 2 AZ1 = S IF( DL.LT.0.0D0 )THEN AZ1 = 2.0D0*PI-AZ1 ENDIF C AZ2 = 2.0D0*PI-AZ1 C C EQUATORIAL - GEODESIC (S - s) "SMS" C ESQP = ESQ/(1.0D0-ESQ) S = DCOS(AZ1) C U2 = ESQP*S*S U4 = U2*U2 U6 = U4*U2 U8 = U6*U2 C T1 = 1.0D0 T2 = (1.0D0/4.0D0)*U2 T4 = (-3.0D0/64.0D0)*U4 T6 = (5.0D0/256.0D0)*U6 T8 = (-175.0D0/16384.0D0)*U8 C BO = T1 + T2 + T4 + T6 + T8 S = DSIN(AZ1) SMS = AMAX*PI*(1.0D0 - FLAT*DABS(S)*AO - BO*(1.0D0-FLAT)) C RETURN END subroutine gvali4 (buff,ll,vali4,icond) implicit integer (i-n) c logical plus,sign,done,error character*1 buff(*) character*1 ch c c integer*2 i c integer*2 l1 c integer*4 ich,icond integer*4 ll integer*4 vali4 c l1 = ll vali4 = 0 icond = 0 plus = .true. sign = .false. done = .false. error = .false. c i = 0 10 i = i+1 if( i.gt.l1 .or. done )then go to 1000 else ch = buff(i) ich = ichar( buff(i) ) endif c if( ch.eq.'+' )then c c enter on plus sign c if( sign )then goto 150 else sign = .true. goto 10 endif elseif( ch.eq.'-' )then c c enter on minus sign c if( sign )then goto 150 else sign = .true. plus = .false. goto 10 endif elseif( ch.ge.'0' .and. ch.le.'9' )then goto 100 elseif( ch.eq.' ' )then c c enter on space -- ignore leading spaces c if( .not.sign )then goto 10 else buff(i) = '0' ich = 48 goto 100 endif elseif( ch.eq.':' )then c c enter on colon -- ignore c if( .not.sign )then goto 10 else goto 1000 endif elseif( ch.eq.'$' )then c c enter on dollar "$" c done = .true. goto 10 else c c something wrong c goto 150 endif c c enter on numeric c 100 vali4 = 10*vali4+(ich-48) sign = .true. goto 10 c c treat illegal character c 150 buff(i) = '0' vali4 = 0 icond = 1 c 1000 if( .not.plus )then vali4 = -vali4 endif c return end subroutine gvalr8 (buff,ll,valr8,icond) implicit integer (i-n) c logical plus,sign,dpoint,done c character*1 buff(*) character*1 ch c c integer*2 i, ip c integer*2 l1 c integer*2 nn, num, n48 c integer*4 ich,icond integer*4 ll c real*8 ten real*8 valr8 real*8 zero c data zero,ten/0.0d0,10.0d0/ c n48 = 48 l1 = ll icond = 0 valr8 = zero plus = .true. sign = .false. dpoint = .false. done = .false. c c start loop thru buffer c i = 0 10 i = i+1 if( i.gt.l1 .or. done )then go to 1000 else ch = buff(i) nn = ichar( ch ) ich = nn endif c if( ch.eq.'+' )then c c enter on plus sign c if( sign )then goto 150 else sign = .true. goto 10 endif elseif( ch.eq.'-' )then c c enter on minus sign c if( sign )then goto 150 else sign = .true. plus = .false. goto 10 endif elseif( ch.eq.'.' )then c c enter on decimal point c ip = 0 sign = .true. dpoint = .true. goto 10 elseif( ch.ge.'0' .and. ch.le.'9' )then goto 100 elseif( ch.eq.' ' )then c c enter on space c if( .not.sign )then goto 10 else buff(i) = '0' ich = 48 goto 100 endif elseif( ch.eq.':' .or. ch.eq.'$' )then c c enter on colon or "$" sign c done = .true. goto 10 else c c something wrong c goto 150 endif c c enter on numeric c 100 sign = .true. if( dpoint )then ip = ip+1 endif c num = ich valr8 = ten*valr8+dble(float( num-n48 )) goto 10 c c treat illegal character c 150 buff(i) = '0' valr8 = 0.0d0 icond = 1 c 1000 if( dpoint )then valr8 = valr8/(ten**ip) endif c if( .not.plus )then valr8 = -valr8 endif c return end subroutine todmsp(val,id,im,s,isign) *** convert position radians to deg,min,sec *** range is [-pi to +pi] implicit double precision(a-h,o-z) common/const/pi,rad 1 if(val.gt.pi) then val=val-pi-pi go to 1 endif 2 if(val.lt.-pi) then val=val+pi+pi go to 2 endif if(val.lt.0.d0) then isign=-1 else isign=+1 endif s=dabs(val*rad) id=idint(s) s=(s-id)*60.d0 im=idint(s) s=(s-im)*60.d0 *** account for rounding error is=idnint(s*1.d5) if(is.ge.6000000) then s=0.d0 im=im+1 endif if(im.ge.60) then im=0 id=id+1 endif return end subroutine trim (buff,lgh,hem) c implicit integer (i-n) character*1 ch,hem character*1 buff(*) integer*4 lgh c ibeg = 1 do 10 i=1,50 if( buff(i).ne.' ' )then goto 11 endif ibeg = ibeg+1 10 continue 11 continue if( ibeg.ge.50 )then ibeg = 1 buff(ibeg) = '0' endif c iend = 50 do 20 i=1,50 j = 51-i if( buff(j).eq.' ' )then iend = iend-1 else goto 21 endif 20 continue 21 continue c ch = buff(ibeg) if( hem.eq.'N' )then if( ch.eq.'N' .or. ch.eq.'n' .or. ch.eq.'+' )then hem = 'N' ibeg = ibeg+1 endif if( ch.eq.'S' .or. ch.eq.'s' .or. ch.eq.'-' )then hem = 'S' ibeg = ibeg+1 endif c c check for wrong hemisphere entry c if( ch.eq.'E' .or. ch.eq.'e' )then hem = '*' ibeg = ibeg+1 endif if( ch.eq.'W' .or. ch.eq.'w' )then hem = '*' ibeg = ibeg+1 endif elseif( hem.eq.'W' )then if( ch.eq.'E' .or. ch.eq.'e' .or. ch.eq.'+' )then hem = 'E' ibeg = ibeg+1 endif if( ch.eq.'W' .or. ch.eq.'w' .or. ch.eq.'-' )then hem = 'W' ibeg = ibeg+1 endif c c check for wrong hemisphere entry c if( ch.eq.'N' .or. ch.eq.'n' )then hem = '*' ibeg = ibeg+1 endif if( ch.eq.'S' .or. ch.eq.'s' )then hem = '*' ibeg = ibeg+1 endif elseif( hem.eq.'A' )then if( .not.('0'.le.ch .and. ch.le.'9') )then hem = '*' ibeg = ibeg+1 endif else c do nothing endif c c do 30 i=ibeg,iend ch = buff(i) c if( ch.eq.':' .or. ch.eq.'.' )then goto 30 elseif( ch.eq.' ' .or. ch.eq.',' )then buff(i) = ':' elseif( '0'.le.ch .and. ch.le.'9' )then goto 30 else buff(i) = ':' endif c 30 continue c c left justify buff() array to its first character position c also check for a ":" char in the starting position, c if found!! skip it c j = 0 ib = ibeg ie = iend c do 40 i=ib,ie if( i.eq.ibeg .and. buff(i).eq.':' )then c c move the 1st position pointer to the next char & c do not put ":" char in buff(j) array where j=1 c ibeg = ibeg+1 goto 40 endif j = j+1 buff(j) = buff(i) 40 continue c c lgh = iend-ibeg+1 j = lgh+1 buff(j) = '$' c c clean-up the rest of the buff() array c do 50 i=j+1,50 buff(i) = ' ' 50 continue c c save a maximum of 20 characters c if( lgh.gt.20 )then lgh = 20 j = lgh+1 buff(j) = '$' endif c return end Geo-Inverse-0.09/perl-Geo-Inverse.spec0000644000175000017500000000321214760761212017060 0ustar mdavismdavisName: perl-Geo-Inverse Version: 0.09 Release: 1%{?dist} Summary: Calculate geographic distance from a lat & lon pair License: perl Group: Development/Libraries URL: http://search.cpan.org/dist/Geo-Inverse/ Source0: http://www.cpan.org/modules/by-module/Geo/Geo-Inverse-%{version}.tar.gz BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildArch: noarch BuildRequires: perl(ExtUtils::MakeMaker) BuildRequires: perl(Geo::Constants) >= 0.04 BuildRequires: perl(Geo::Ellipsoids) >= 0.09 BuildRequires: perl(Geo::Functions) >= 0.03 BuildRequires: perl(Package::New) BuildRequires: perl(Test::Simple) >= 0.44 BuildRequires: perl(Test::Number::Delta) Requires: perl(Geo::Constants) >= 0.04 Requires: perl(Geo::Ellipsoids) >= 0.09 Requires: perl(Geo::Functions) >= 0.03 Requires: perl(Package::New) Requires: perl(:MODULE_COMPAT_%(eval "`%{__perl} -V:version`"; echo $version)) %description This module is a pure Perl port of the NGS program in the public domain "inverse" by Robert (Sid) Safford and Stephen J. Frakes. %prep %setup -q -n Geo-Inverse-%{version} %build %{__perl} Makefile.PL INSTALLDIRS=vendor make %{?_smp_mflags} %install rm -rf $RPM_BUILD_ROOT make pure_install PERL_INSTALL_ROOT=$RPM_BUILD_ROOT find $RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} \; find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; %{_fixperms} $RPM_BUILD_ROOT/* %check make test %clean rm -rf $RPM_BUILD_ROOT %files %defattr(-,root,root,-) %doc Changes LICENSE README.md %{perl_vendorlib}/* %{_mandir}/man3/* %changelog Geo-Inverse-0.09/t/0000755000175000017500000000000014761176736013402 5ustar mdavismdavisGeo-Inverse-0.09/t/001_qgis_compare.t0000644000175000017500000000452014760477520016613 0ustar mdavismdavis#!/usr/bin/perl use strict; use warnings; use Test::Number::Delta relative => 1e-7; use Test::More tests => 10; BEGIN{use_ok('Geo::Inverse');}; my $debug = $ENV{'TEST_DEBUG'}; my $o = Geo::Inverse->new; isa_ok($o, 'Geo::Inverse'); { #MultiLineString ((-77.03460486004219376 38.8897543336967928, -77.00897613176105949 38.88988090882982362)) #2223.60811 m my $dist_qgis = 2223.60811; my $dist_perl = $o->inverse(38.88975433369679, -77.0346048600422, 38.889880908829824, -77.00897613176106); diag("\nDist: Perl => $dist_perl m, QGIS => $dist_qgis m") if $debug; delta_within($dist_perl, $dist_qgis, 1e-5, 'distance compares to qgis'); delta_ok($dist_perl, $dist_qgis, 'distance compares to qgis to about 7 significant figures'); } { #MultiLineString ((-77.0365381628055701 38.89762940542472336, -77.03648927884935915 38.89397532969779547)) #405.67388 m my $dist_qgis = 405.67388; my $dist_perl = $o->inverse(38.89762940542472336, -77.0365381628055701, 38.89397532969779547, -77.03648927884935915); diag("\nDist: Perl => $dist_perl m, QGIS => $dist_qgis m") if $debug; delta_within($dist_perl, $dist_qgis, 1e-5, 'distance compares to qgis'); delta_ok($dist_perl, $dist_qgis, 'distance compares to qgis to about 7 significant figures'); } { #MultiLineString ((-77.03655343904441111 38.89770063088451479, -77.43355694679300427 37.53881754174707197)) #154791.10 m my $dist_qgis = 154791.10; my $dist_perl = $o->inverse(38.89770063088451479, -77.03655343904441111, 37.53881754174707197, -77.43355694679300427); diag("\nDist: Perl => $dist_perl m, QGIS => $dist_qgis m") if $debug; delta_within($dist_perl, $dist_qgis, 1e-2, 'distance compares to qgis to about 7 significant figures'); delta_ok($dist_perl, $dist_qgis, 'distance compares to qgis to about 7 significant figures'); } { #MultiLineString ((-77.03655343904441111 38.89770063088451479, -121.49340089639481732 38.5765645457972326)) #3826214.64 m my $dist_qgis = 3826214.64; my $dist_perl = $o->inverse(38.89770063088451479, -77.03655343904441111, 38.5765645457972326, -121.49340089639481732); diag("\nDist: Perl => $dist_perl m, QGIS => $dist_qgis m") if $debug; delta_within($dist_perl, $dist_qgis, 1e-2, 'distance compares to qgis to about 7 significant figures'); delta_ok($dist_perl, $dist_qgis, 'distance compares to qgis to about 7 significant figures'); } Geo-Inverse-0.09/t/000_load.t0000644000175000017500000000325014760474655015065 0ustar mdavismdavis#!/usr/bin/perl use strict; use warnings; use Test::Number::Delta relative => 1e-7; use Test::More tests => 20; BEGIN{use_ok 'Geo::Inverse'}; my $o = Geo::Inverse->new; ok(ref $o, 'Geo::Inverse'); { my ($faz, $baz, $dist)=$o->inverse(34.5,-77.5,35,-78); delta_ok($faz, d(320,36,23.2945)); delta_ok($baz, d(140,19,17.2861)); delta_ok($dist, 71921.4677); } { my ($faz, $baz, $dist)=$o->inverse(34.5,-77.5,d(34,11,11),-1*d(77,45,45)); delta_ok($faz, d(214,50,44.6531)); delta_ok($baz, d(34,41,51.5299)); delta_ok($dist, 42350.9312); } { my ($faz, $baz, $dist) = $o->inverse(d(qw{67 34 54.65443}),-1*d(qw{118 23 54.24523}), d(qw{67 45 32.65433}),-1*d(qw{118 34 43.23454})); delta_ok($faz, d(qw{338 56 3.2089})); delta_ok($baz, d(qw{158 46 2.8840})); delta_ok($dist, 21193.2643); } { my $dist = $o->inverse(d(qw{67 34 54.65443}),-1*d(qw{118 23 54.24523}), d(qw{67 45 32.65433}),-1*d(qw{118 34 43.23454})); delta_ok($dist, 21193.2643); } { local $@; my $dist = eval{$o->inverse(undef,1,1,1)}; my $error = $@; ok($error); like($error, qr/\ASyntax Error: function inverse lat1/); } { local $@; my $dist = eval{$o->inverse(1,undef,1,1)}; my $error = $@; ok($error); like($error, qr/\ASyntax Error: function inverse lon1/); } { local $@; my $dist = eval{$o->inverse(1,1,undef,1)}; my $error = $@; ok($error); like($error, qr/\ASyntax Error: function inverse lat2/); } { local $@; my $dist = eval{$o->inverse(1,1,1,undef)}; my $error = $@; ok($error); like($error, qr/\ASyntax Error: function inverse lon2/); } sub d {my ($d,$m,$s)=@_; return($d + ($m + $s/60)/60)}; Geo-Inverse-0.09/CONTRIBUTING.md0000644000175000017500000000024414341522035015345 0ustar mdavismdavis# Contributing Guidelines Fork repository on GitHub and submit a pull request. Submitting a pull request indicates your acceptance of the license of the project. Geo-Inverse-0.09/LICENSE0000644000175000017500000005010114760476506014136 0ustar mdavismdavisTerms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS --------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Geo-Inverse-0.09/lib/0000755000175000017500000000000014761176736013705 5ustar mdavismdavisGeo-Inverse-0.09/lib/Geo/0000755000175000017500000000000014761176736014417 5ustar mdavismdavisGeo-Inverse-0.09/lib/Geo/Inverse.pm0000644000175000017500000001327714760761051016367 0ustar mdavismdavispackage Geo::Inverse; use strict; use warnings; use base qw{Package::New}; use Geo::Constants qw{PI}; use Geo::Functions qw{rad_deg deg_rad}; use Geo::Ellipsoids; our $VERSION = '0.09'; =head1 NAME Geo::Inverse - Calculate geographic distance from a latitude and longitude pair =head1 SYNOPSIS use Geo::Inverse; my $obj = Geo::Inverse->new(); #default "WGS84" my ($lat1, $lon1, $lat2, $lon2) = (38.87, -77.05, 38.95, -77.23); my ($faz, $baz, $dist) = $obj->inverse($lat1, $lon1, $lat2, $lon2); #array context my $dist = $obj->inverse($lat1, $lon1, $lat2, $lon2); #scalar context print "Input Lat: $lat1 Lon: $lon1\n"; print "Input Lat: $lat2 Lon: $lon2\n"; print "Output Distance: $dist\n"; print "Output Forward Azimuth: $faz\n"; print "Output Back Azimuth: $baz\n"; =head1 DESCRIPTION This module is a pure Perl port of the NGS program in the public domain "inverse" by Robert (Sid) Safford and Stephen J. Frakes. =head1 CONSTRUCTOR =head2 new The new() constructor may be called with any parameter that is appropriate to the ellipsoid method which establishes the ellipsoid. my $obj = Geo::Inverse->new(); # default "WGS84" =head1 METHODS =head2 initialize =cut sub initialize { my $self = shift; my $param = shift || undef; $self->ellipsoid($param); } =head2 ellipsoid Method to set or retrieve the current ellipsoid object. The ellipsoid is a Geo::Ellipsoids object. my $ellipsoid = $obj->ellipsoid; #Default is WGS84 $obj->ellipsoid('Clarke 1866'); #Built in ellipsoids from Geo::Ellipsoids $obj->ellipsoid({a=>1}); #Custom Sphere 1 unit radius =cut sub ellipsoid { my $self = shift; if (@_) { my $param = shift(); $self->{'ellipsoid'} = Geo::Ellipsoids->new($param); } return $self->{'ellipsoid'}; } =head2 inverse This method is the user frontend to the mathematics. This interface will not change in future versions. my ($faz, $baz, $dist) = $obj->inverse($lat1,$lon1,$lat2,$lon2); =cut sub inverse { my $self = shift; my $lat1 = shift; #degrees my $lon1 = shift; #degrees my $lat2 = shift; #degrees my $lon2 = shift; #degrees die('Syntax Error: function inverse lat1 not defined') unless defined $lat1; die('Syntax Error: function inverse lon1 not defined') unless defined $lon1; die('Syntax Error: function inverse lat2 not defined') unless defined $lat2; die('Syntax Error: function inverse lon2 not defined') unless defined $lon2; my ($faz, $baz, $dist) = $self->_inverse(rad_deg($lat1), rad_deg($lon1), rad_deg($lat2), rad_deg($lon2)); return wantarray ? (deg_rad($faz), deg_rad($baz), $dist) : $dist; } ######################################################################## # # This function was copied from Geo::Ellipsoid # Copyright 2005-2006 Jim Gibson, all rights reserved. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # internal functions # # inverse # # Calculate the displacement from origin to destination. # The input to this subroutine is # ( latitude-1, longitude-1, latitude-2, longitude-2 ) in radians. # # Return the results as the list (range,bearing) with range in meters # and bearing in radians. # ######################################################################## sub _inverse { my $self = shift; my( $lat1, $lon1, $lat2, $lon2 ) = (@_); my $ellipsoid=$self->ellipsoid; my $a = $ellipsoid->a; my $f = $ellipsoid->f; my $eps = 1.0e-23; my $max_loop_count = 20; my $pi=PI; my $twopi = 2 * $pi; my $r = 1.0 - $f; my $tu1 = $r * sin($lat1) / cos($lat1); my $tu2 = $r * sin($lat2) / cos($lat2); my $cu1 = 1.0 / ( sqrt(($tu1*$tu1) + 1.0) ); my $su1 = $cu1 * $tu1; my $cu2 = 1.0 / ( sqrt( ($tu2*$tu2) + 1.0 )); my $s = $cu1 * $cu2; my $baz = $s * $tu2; my $faz = $baz * $tu1; my $dlon = $lon2 - $lon1; my $x = $dlon; my $cnt = 0; my( $c2a, $c, $cx, $cy, $cz, $d, $del, $e, $sx, $sy, $y ); do { $sx = sin($x); $cx = cos($x); $tu1 = $cu2*$sx; $tu2 = $baz - ($su1*$cu2*$cx); $sy = sqrt( $tu1*$tu1 + $tu2*$tu2 ); $cy = $s*$cx + $faz; $y = atan2($sy,$cy); my $sa; if( $sy == 0.0 ) { $sa = 1.0; }else{ $sa = ($s*$sx) / $sy; } $c2a = 1.0 - ($sa*$sa); $cz = $faz + $faz; if( $c2a > 0.0 ) { $cz = ((-$cz)/$c2a) + $cy; } $e = ( 2.0 * $cz * $cz ) - 1.0; $c = ( ((( (-3.0 * $c2a) + 4.0)*$f) + 4.0) * $c2a * $f )/16.0; $d = $x; $x = ( ($e * $cy * $c + $cz) * $sy * $c + $y) * $sa; $x = ( 1.0 - $c ) * $x * $f + $dlon; $del = $d - $x; } while( (abs($del) > $eps) && ( ++$cnt <= $max_loop_count ) ); $faz = atan2($tu1,$tu2); $baz = atan2($cu1*$sx,($baz*$cx - $su1*$cu2)) + $pi; $x = sqrt( ((1.0/($r*$r)) -1.0 ) * $c2a+1.0 ) + 1.0; $x = ($x-2.0)/$x; $c = 1.0 - $x; $c = (($x*$x)/4.0 + 1.0)/$c; $d = ((0.375*$x*$x) - 1.0)*$x; $x = $e*$cy; $s = 1.0 - $e - $e; $s = (((((((( $sy * $sy * 4.0 ) - 3.0) * $s * $cz * $d/6.0) - $x) * $d /4.0) + $cz) * $sy * $d) + $y ) * $c * $a * $r; # adjust azimuth to (0,360) $faz += $twopi if $faz < 0; return($faz, $baz, $s); } =head1 LIMITATIONS No guarantees that Perl handles all of the double precision calculations in the same manner as Fortran. =head1 LICENSE Copyright (c) 2025 Michael R. Davis Copyright (c) 2005-2006 Jim Gibson, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L =cut 1; Geo-Inverse-0.09/README.md0000644000175000017500000000370714341524071014404 0ustar mdavismdavis# NAME Geo::Inverse - Calculate geographic distance from a latitude and longitude pair # SYNOPSIS use Geo::Inverse; my $obj = Geo::Inverse->new(); #default "WGS84" my ($lat1, $lon1, $lat2, $lon2) = (38.87, -77.05, 38.95, -77.23); my ($faz, $baz, $dist) = $obj->inverse($lat1,$lon1,$lat2,$lon2); #array context my $dist=$obj->inverse($lat1, $lon1, $lat2, $lon2); #scalar context print "Input Lat: $lat1 Lon: $lon1\n"; print "Input Lat: $lat2 Lon: $lon2\n"; print "Output Distance: $dist\n"; print "Output Forward Azimuth: $faz\n"; print "Output Back Azimuth: $baz\n"; # DESCRIPTION This module is a pure Perl port of the NGS program in the public domain "inverse" by Robert (Sid) Safford and Stephen J. Frakes. # CONSTRUCTOR ## new The new() constructor may be called with any parameter that is appropriate to the ellipsoid method which establishes the ellipsoid. my $obj = Geo::Inverse->new(); # default "WGS84" # METHODS ## initialize ## ellipsoid Method to set or retrieve the current ellipsoid object. The ellipsoid is a Geo::Ellipsoids object. my $ellipsoid = $obj->ellipsoid; #Default is WGS84 $obj->ellipsoid('Clarke 1866'); #Built in ellipsoids from Geo::Ellipsoids $obj->ellipsoid({a=>1}); #Custom Sphere 1 unit radius ## inverse This method is the user frontend to the mathematics. This interface will not change in future versions. my ($faz, $baz, $dist) = $obj->inverse($lat1,$lon1,$lat2,$lon2); # BUGS Please open an issue on GitHub # LIMITS No guarantees that Perl handles all of the double precision calculations in the same manner as Fortran. # LICENSE MIT License Copyright (c) 2022 Michael R. Davis # SEE ALSO [Geo::Ellipsoid](https://metacpan.org/pod/Geo::Ellipsoid), [GIS::Distance::GeoEllipsoid](https://metacpan.org/pod/GIS::Distance::GeoEllipsoid), [Geo::Calc](https://metacpan.org/pod/Geo::Calc) Geo-Inverse-0.09/Makefile.PL0000644000175000017500000000231114760760754015104 0ustar mdavismdavisuse ExtUtils::MakeMaker; WriteMakefile( NAME => q{Geo::Inverse}, VERSION_FROM => 'lib/Geo/Inverse.pm', ABSTRACT_FROM => 'lib/Geo/Inverse.pm', PREREQ_PM => { 'Test::Simple' => 0.44, 'Test::Number::Delta' => 0, 'Package::New' => 0, 'Geo::Constants' => 0.04, 'Geo::Functions' => 0.03, 'Geo::Ellipsoids' => 0.09, }, 'META_MERGE' => { 'resources' => { 'repository' => { 'web' => 'https://github.com/mrdvt92/perl-Geo-Inverse.git', 'url' => 'git@github.com:mrdvt92/perl-Geo-Inverse.git', 'type' => 'git' }, 'homepage' => 'https://github.com/mrdvt92/perl-Geo-Inverse', 'bugtracker' => { 'web' => 'https://github.com/mrdvt92/perl-Geo-Inverse/issues' } }, 'meta-spec' => { 'version' => 2 }, }, ); Geo-Inverse-0.09/META.yml0000644000175000017500000000157114761176736014414 0ustar mdavismdavis--- abstract: 'Calculate geographic distance from a latitude and longitude pair' author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Geo-Inverse no_index: directory: - t - inc requires: Geo::Constants: '0.04' Geo::Ellipsoids: '0.09' Geo::Functions: '0.03' Package::New: '0' Test::Number::Delta: '0' Test::Simple: '0.44' resources: bugtracker: https://github.com/mrdvt92/perl-Geo-Inverse/issues homepage: https://github.com/mrdvt92/perl-Geo-Inverse repository: https://github.com/mrdvt92/perl-Geo-Inverse.git version: '0.09' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Geo-Inverse-0.09/META.json0000644000175000017500000000265714761176736014572 0ustar mdavismdavis{ "abstract" : "Calculate geographic distance from a latitude and longitude pair", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Geo-Inverse", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Geo::Constants" : "0.04", "Geo::Ellipsoids" : "0.09", "Geo::Functions" : "0.03", "Package::New" : "0", "Test::Number::Delta" : "0", "Test::Simple" : "0.44" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/mrdvt92/perl-Geo-Inverse/issues" }, "homepage" : "https://github.com/mrdvt92/perl-Geo-Inverse", "repository" : { "type" : "git", "web" : "https://github.com/mrdvt92/perl-Geo-Inverse.git" } }, "version" : "0.09", "x_serialization_backend" : "JSON::PP version 4.06" }