Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

SLL - NavCalcsSLL - Great Circle and Rhumb Line navigation functions

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    PBWin/PBCC SLL - NavCalcsSLL - Great Circle and Rhumb Line navigation functions

    I recenty needed my Great CIrcle navigation functions again so decided to turn them into an SLL:
    (Posted in full here so that you don't have to follow a link to another site that may disappear like so many other PB forum links have over the years.)

    Discussion thread here: https://forum.powerbasic.com/forum/u...in-source-code

    Useable with both PBWin and PBCC

    '
    Code:
    'NAvCalcsSLL - Great Circle and Rhumb Line navigation functions
'====================== NavCalcs.SLL Common Functions ==================================
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Nav Calculations
'------------------
''Distances in Nautical Miles, Latitudes and Longitudes in Degrees (S/W = Negative)
'FUNCTION nc_GCDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Great Circle distance
'
'FUNCTION nc_GCDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Great Circle Initial Bearing
'
'FUNCTION nc_RhumbDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Rhumb Line direction in degrees
'
'FUNCTION nc_RhumbDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Rhumb line distance
'
'FUNCTON nc_Lat2Lon2 (lat1 AS EXT, lon1 AS EXT, Dist AS EXT, bearing AS EXT, BYREF lat2 AS EXT, BYREF lon2 AS EXT) COMMON AS LONG
'     'Location Lat2,Lon2 at a GC distance and bearing from Lat1,Lon1
'     'Caution: Precision of result is potentially much higher than accuracy, because of complexity of floating point math
'     '(Expect a potential error in Lat/Lon of up to 1NM per 1000NM i.e  +/-0.1% of distance)
'
'Distance Conversions
'--------------------
'FUNCTION nc_NMToKM(nm AS EXT) COMMON AS EXT
'    'Convert Nautical Miles to Kilometers
'
'FUNCTION nc_NMToSM(nm  AS EXT) COMMON AS EXT
'    'Convert Nautical Miles to Statute Miles
'
'Lat/Lon Format conversion Functions
'------------------------------------
'FUNCTION nc_LatStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Latitude DMS or DM.m string to degrees

'FUNCTION nc_LontStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Longitude DMS or DM.m string to degrees

'FUNCTION nc_LatDtoDMS(BYVAL D AS EXT) AS STRING
''convert latitude degrees to string in form (DMS) 0°0'0"N
'
'FUNCTION nc_LonDtoDMS(BYVAL D AS EXT) COMMON AS STRING
''convert Longitude degrees to string in form 0°0'0"E
'
'FUNCTION nc_LatDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
''convert latitude degrees to string in form 0°0.000'N (minutes to MinDecPl decimal places)
'' MinDecPl = Minute Decimal Places
'
'FUNCTION nc_LonDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
''convert Longitude degrees to string in form 0°0.000'E (minutes to MinDecPl decimal places)
'' MinDecPl = Minute Decmal Places
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

#COMPILE SLL "NavCalcs.SLL"
#DIM ALL

MACRO EarthRadiusNM = 3440.06479481645## 'mean radius of the Earth in Nautical Miles
MACRO Pi = 3.14159265358979324##
MACRO TwoPi = 6.283185307179586##
MACRO HalfPi = 1.57079632679489662##
MACRO QtrPi = 0.7853981633974483##
MACRO DegToRad(d) = (d * 0.0174532925199432958##)
MACRO RadToDeg(r) = (r * 57.2957795130823209##)
MACRO RadToNM(r) = (r * 3437.74677078493925##)

FUNCTION nc_GCDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2,lon1, lon2 AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    FUNCTION = RadToNM(2 * arcsin(SQR((SIN((lat1 - lat2) / 2)) ^ 2 + COS(lat1) * COS(lat2) * (SIN((lon1 - lon2) / 2)) ^ 2)))
END FUNCTION

FUNCTION nc_GCDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    FUNCTION = (RadToDeg(ATAN2(COS(lat1)*SIN(lat2)-SIN(lat1)*COS(lat2)*COS(lon2-lon1),SIN(lon2-lon1)*COS(lat2))) +360) MOD 360
END FUNCTION

FUNCTION nc_RhumbDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    LOCAL dlon, dphi, q AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    dLon = DegToRad(lon2) - DegToRad(lon1)
    dPhi = LOG(TAN(DegToRad(lat2) / 2 + QtrPi) / TAN(DegToRad(lat1) / 2 + QtrPi))
    IF(ABS(dLon) > pi) THEN
      IF(dLon > 0) THEN
         dLon = (TwoPi - dLon) * -1
      ELSE
         dLon = TwoPi + dLon
      END IF
    END IF
    FUNCTION = (RadToDeg(atan2(dPhi,dLon)) + 360) MOD 360
 END FUNCTION

FUNCTION nc_RhumbDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    LOCAL dlon_W, dlon_E, dphi, q AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    dlon_W = ModDbl(TwoPi, (lon2 - lon1))
    dlon_E = ModDbl(TwoPi, (lon1 - lon2))
    dphi = LOG(TAN(lat2 / 2 + QtrPi) / TAN(lat1 / 2 + QtrPi))
    IF (ABS(lat2 - lat1) < 0.00000001) THEN
         q = COS(lat1)
    ELSE
         q = (lat2 - lat1) / dphi
    END IF
    IF (dlon_W < dlon_E) THEN ' Westerly rhumb line is the shortest
          FUNCTION = radToNM(SQR(q ^ 2 * dlon_W ^ 2 + (lat2 - lat1) ^ 2))
    ELSE
          FUNCTION = radToNM(SQR(q ^ 2 * dlon_E ^ 2 + (lat2 - lat1) ^ 2))
    END IF
END FUNCTION

FUNCTION nc_Lat2Lon2 (lat1 AS EXT, lon1 AS EXT, Dist AS EXT, bearing AS EXT, BYREF lat2 AS EXT, BYREF lon2 AS EXT) COMMON AS LONG
   LOCAL la1,lo1,la2,lo2,D,B AS EXT
   la1 = degToRad(lat1)
   lo1 = degToRad(lon1)
   D = Dist/EarthRadiusNM
   B = degtoRad(bearing)
   la2 = arcsin(SIN(la1) * COS(D) + COS(la1) * SIN(D) * COS(B))
   lo2 = lo1 + atan2(COS(D)-SIN(la1) * SIN(la2),SIN(B) * SIN(D) * COS(la1))
   IF ABS(lo2) > pi THEN lo2 = -(twopi-lo2)
   lat2 = radToDeg(la2)
   lon2= radToDeg(Lo2)
END FUNCTION

'Distance Conversions
FUNCTION nc_NMToKM(nm AS EXT) COMMON AS EXT
    FUNCTION = nm * 1.852##
END FUNCTION
FUNCTION nc_NMToSM(nm  AS EXT) COMMON AS EXT
    'Convert Nautical Miles to Kilometers
    FUNCTION = nm * 1.150779##
END FUNCTION

  'Lat/Lon Format conversion Functions
'------------------------------------
FUNCTION nc_LatStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Latitude DMS or DM.m string to degrees
    LOCAL sLat AS STRING
    LOCAL deg AS EXT
    LOCAL direction AS LONG
    sLat = ls
    direction = 1
    IF INSTR(sLat,ANY "sS-") THEN direction = -1
    sLat = REMOVE$(sLat, ANY "-sSNn"" ")
    REPLACE ANY "°'" WITH ($TAB & $TAB) IN sLat
    'REPLACE "'" WITH $TAB IN sLat
    FUNCTION = direction * (VAL(PARSE$(sLat,$TAB,1)) + VAL(PARSE$(sLat,$TAB,2))/60 + VAL(PARSE$(sLat,$TAB,3))/3600)
  END FUNCTION

 FUNCTION nc_LonStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Longitude DMS or DM.m string to degrees
    LOCAL sLat AS STRING
    LOCAL deg AS EXT
    LOCAL direction AS LONG
    sLat = ls
    direction = 1
    IF INSTR(sLat,ANY "wW-") THEN direction = -1
    sLat = REMOVE$(sLat, ANY "-wWeE"" ")
    REPLACE "°" WITH $TAB IN sLat
    REPLACE "'" WITH $TAB IN sLat
    FUNCTION = direction * (VAL(PARSE$(sLat,$TAB,1)) + VAL(PARSE$(sLat,$TAB,2))/60 + VAL(PARSE$(sLat,$TAB,3))/3600)
  END FUNCTION

FUNCTION nc_LatDtoDMS(BYVAL D AS EXT) COMMON AS STRING
LOCAL Deg AS LONG
LOCAL Mn  AS EXT
LOCAL Sec AS EXT
LOCAL Cardinal AS STRING
Cardinal = "N"
IF SGN(D)= -1 THEN Cardinal = "S" : D = ABS(D)
Deg = INT(D)
Mn  = FRAC(D)* 60
Sec = ROUND(FRAC(Mn) * 60, 2)
Mn = INT(Mn)
FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn) & "'" & FORMAT$(Sec) & $DQ  & Cardinal
END FUNCTION

FUNCTION nc_LonDtoDMS(BYVAL D AS EXT) COMMON AS STRING
LOCAL Deg AS LONG
LOCAL Mn  AS EXT
LOCAL Sec AS EXT
LOCAL Cardinal AS STRING
Cardinal = "E"
IF SGN(D) = -1 THEN Cardinal = "W" : D = ABS(D)
Deg = INT(D)
Mn  = FRAC(D)* 60
Sec = ROUND(FRAC(Mn) * 60, 2)
Mn = INT(Mn)
FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn) & "'" + FORMAT$(Sec) & $DQ & Cardinal
END FUNCTION

FUNCTION nc_LatDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
LOCAL Deg AS LONG
LOCAL Mn  AS EXT
LOCAL Cardinal AS STRING
Cardinal = "N"
IF SGN(D)= -1 THEN Cardinal = "S" : D = ABS(D)
Deg = INT(D)
Mn  = FRAC(D)* 60
IF MinDecPl > 0 THEN
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn,"0." & STRING$(MinDecPl,"0")) & "'" & Cardinal
ELSE
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(CINT(Mn)) &  "'" & Cardinal
END IF

END FUNCTION

FUNCTION nc_LonDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
LOCAL Deg AS LONG
LOCAL Mn  AS EXT
LOCAL Sec AS EXT
LOCAL Cardinal AS STRING
Cardinal = "E"
IF SGN(D) = -1 THEN Cardinal = "W" : D = ABS(D)
Deg = INT(D)
Mn  = FRAC(D)* 60
IF MinDecPl > 0 THEN
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn,"0." & STRING$(MinDecPl,"0")) & "'" & Cardinal
ELSE
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(CINT(Mn)) &  "'" & Cardinal
END IF
END FUNCTION

'Math Helpers
FUNCTION arcsin(X AS EXT) AS EXT
    FUNCTION = ATN(X / SQR(1 - X * X ))
END FUNCTION

FUNCTION arccos(X AS EXT) AS EXT
    FUNCTION = HalfPi - ATN(X / SQR(1 - X * X ) )
END FUNCTION

FUNCTION atan2(x AS EXT, y AS EXT) AS EXT
  SELECT CASE X
    CASE IS > 0
        FUNCTION = ATN(y / X) '     x>0
    CASE IS = 0
        SELECT CASE y
            CASE IS > 0
                FUNCTION = HalfPi      ' x=0, y>0
            CASE IS < 0
                FUNCTION = - HalfPi     'x=0, y<0
            CASE 0
                FUNCTION = 0      'x = 0, y = 0
        END SELECT
    CASE IS < 0
         SELECT CASE y
            CASE IS >= 0
                FUNCTION = ATN(y / X) + pi ' x<0, y>=0
            CASE IS < 0
                FUNCTION = ATN(y / X) - pi 'x<0, y<0
          END SELECT
    END SELECT
END FUNCTION

FUNCTION ModDbl(X AS EXT, y AS EXT) AS EXT
  'Modulus of floating point values - used in Rhumb Line calculations
  IF y >= 0 THEN
    FUNCTION = y - X * INT(y / X)
  ELSE
    FUNCTION = y + X * (INT(-y / X) + 1)
  END IF
END FUNCTION
'
    and a test harness useable in both PBWIn10 and PBCC6

    '
    Code:
    #COMPILE EXE
#DIM ALL
#LINK "NavCalcs.SLL"

FUNCTION PBMAIN() AS LONG
    LOCAL lDebug AS LONG: TXT.WINDOW EXE.FULL$, 200,50,40,85 TO lDebug

    LOCAL sla1,slo1,sla2,slo2 AS STRING   'Lat and Lon strings
    LOCAL la1,lo1,la2,lo2 AS EXT 'Lat and long as degrees
    LOCAL d,b,d2,b2 AS EXT 'distance (NM) and bearing (degrees)

    'Initialise locations with strings (DM.m)
    sla1 = "9°27.9'S" :slo1 = "147°11.5'E" 'Port Moresby
    sla2 = "51°28' N" :slo2 = "0°12' E" ' Greenwich

    'Convert Lat/Lon strings to Degrees
    la1= nc_LatstrToDeg(sla1):lo1= nc_LonStrToDeg(slo1)
    la2= nc_LatstrToDeg(sla2):lo2= nc_LonStrToDeg(slo2)

    'Display Back conversion as test of conversion functions
    TXT.PRINT "From: " & nc_LatDtoDM(la1,2) & ", " & nc_LonDtoDM(lo1,2)
    TXT.PRINT "To: " & nc_LatDtoDM(la2,2) & ", " & nc_LonDtoDM(lo2,2)
    TXT.PRINT

    'Great Circle distance and bearing
    d = nc_gcdist(la1,lo1,la2,lo2)
    b = nc_gcdir(la1,lo1,la2,lo2)
    TXT.PRINT "Great Circle Distance: " & FORMAT$(d,"0.0" ) & "NM";"  ("; FORMAT$(nc_NMtoKM(d),"0.0" ) & "km, ";FORMAT$(nc_NMtoSM(d),"0.0" ) & " miles)"
    TXT.PRINT "Great Circle Bearing: " & FORMAT$(b," 0.0") & "°"

    'Rhumb Line Distance and Bearing
    d2 = nc_rhumbdist(la1,lo1,la2,lo2)
    b2= nc_rhumbdir(la1,lo1,la2,lo2)
    TXT.PRINT "Rhumb Line Distance: " & FORMAT$(d2,"0.0" ) & "NM";"  ("; FORMAT$(nc_NMtoKM(d2),"0.0" ) & "km, ";FORMAT$(nc_NMtoSM(d2),"0.0" ) & " miles)"
    TXT.PRINT "Rhumb Line Bearing: " & FORMAT$(b2,"000.0")  & "°"
    TXT.PRINT
    'Location at a GC distance and bearing from first Location
    nc_Lat2Lon2 la1,lo1,d,b ,la2,lo2
    TXT.PRINT FORMAT$(d," 0.00");"NM  on a bearing of ";FORMAT$(b,"0.0"); "° from: " & nc_LatDtoDM(la1,2) & ", " & nc_LonDtoDM(lo1,2)
    TXT.PRINT "    takes us to: ";nc_LatDtoDM(la2,0) & ", " & nc_LonDtoDM(lo2,0); " (approx)"
    TXT.PRINT "    (+/- 0.1% of distance! i.e error of up to "; FORMAT$(d/1000,"0.0"); "NM in this case)"

    TXT.COLOR = %RGB_BLUE
    TXT.PRINT
    TXT.PRINT "  ....Press any key to exit": TXT.WAITKEY$: TXT.END
END FUNCTION
'
    Click image for larger version Name: NacCalcs.jpg Views: 0 Size: 91.3 KB ID: 814627
    Attached Files
    Tags: None
  • #2


    > Posted in full here so that you don't have to follow a link to another site that may disappear like so many other PB forum links have over the years.

    Yeah, we know its tough when you have to try and foulmouth a site that been running for over 20 years.

    PS : Pleased to see you post some SLL code.
    hutch at movsd dot com
    The MASM Forum - SLL Modules and PB Libraries
    http://www.masm32.com/board/index.php?board=69.0

    Comment

    • #3
      Now, I have just had a quick look and it looks like you have some useful code but why have you bundled them all together in one file ? With each COMMON function, you would get the minimum granularity if you put each one into a separate SLL module and if you wanted them bundled together, you would then construct a library out of the modules.

      LATER : Quick fix attached.
      Attached Files
      hutch at movsd dot com
      The MASM Forum - SLL Modules and PB Libraries
      http://www.masm32.com/board/index.php?board=69.0

      Comment

      • #4
        New version of SLL
        • ModifiedC FUNCTON nc_Lat2Lon2 () to correctly calculate final longitude when initial latitudes is exactly +/-90°
        • Changed value of earth radius macro . New value is number of arc minutes in a radian, rather than generally quoted "mean radius". This removes the discrepancy from nc_Lat2Lon2
        '
        Code:
        'NAvCalcsSLL - Great Circle and Rhumb Line navigation functions
'====================== NavCalcs.SLL Common Functions ==================================
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Nav Calculations
'------------------
''Distances in Nautical Miles, Latitudes and Longitudes in Degrees (S/W = Negative)
'FUNCTION nc_GCDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Great Circle distance
'
'FUNCTION nc_GCDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Great Circle Initial Bearing
'
'FUNCTION nc_RhumbDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Rhumb Line direction in degrees
'
'FUNCTION nc_RhumbDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
'    'Rhumb line distance
'
'FUNCTON nc_Lat2Lon2 (lat1 AS EXT, lon1 AS EXT, Dist AS EXT, bearing AS EXT, BYREF lat2 AS EXT, BYREF lon2 AS EXT) COMMON AS LONG
'     'Location Lat2,Lon2 at a GC distance and bearing from Lat1,Lon1

'Distance Conversions
'--------------------
'FUNCTION nc_NMToKM(nm AS EXT) COMMON AS EXT
'    'Convert Nautical Miles to Kilometers
'
'FUNCTION nc_NMToSM(nm  AS EXT) COMMON AS EXT
'    'Convert Nautical Miles to Statute Miles
'
'Lat/Lon Format conversion Functions
'------------------------------------
'FUNCTION nc_LatStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Latitude DMS or DM.m string to degrees

'FUNCTION nc_LontStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Longitude DMS or DM.m string to degrees

'FUNCTION nc_LatDtoDMS(BYVAL D AS EXT) AS STRING
''convert latitude degrees to string in form (DMS) 0°0'0"N
'
'FUNCTION nc_LonDtoDMS(BYVAL D AS EXT) COMMON AS STRING
''convert Longitude degrees to string in form 0°0'0"E
'
'FUNCTION nc_LatDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
''convert latitude degrees to string in form 0°0.000'N (minutes to MinDecPl decimal places)
'' MinDecPl = Minute Decimal Places
'
'FUNCTION nc_LonDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
''convert Longitude degrees to string in form 0°0.000'E (minutes to MinDecPl decimal places)
'' MinDecPl = Minute Decmal Places
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

#COMPILE SLL "NavCalcs.SLL"
#DIM ALL

MACRO Pi =     3.14159265358979324##
MACRO TwoPi =  6.28318530717958648##
MACRO HalfPi = 1.57079632679489662##
MACRO QtrPi =  0.78539816339744831##
MACRO DegToRad(d) = (d * 0.0174532925199432958##)
MACRO RadToDeg(r) = (r * 57.2957795130823209##)
MACRO RadToNM(r) = (r * 3437.74677078493925##)
MACRO EarthRadiusNM = 3437.74677078493925## 'based on arcminutes/radians rather than oft quoted "mean radius" of 3440

FUNCTION nc_GCDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2,lon1, lon2 AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    FUNCTION = RadToNM(2 * arcsin(SQR((SIN((lat1 - lat2) / 2)) ^ 2 + COS(lat1) * COS(lat2) * (SIN((lon1 - lon2) / 2)) ^ 2)))
END FUNCTION

FUNCTION nc_GCDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)

    FUNCTION = (RadToDeg(ATAN2(COS(lat1)*SIN(lat2)-SIN(lat1)*COS(lat2)*COS(lon2-lon1),SIN(lon2-lon1)*COS(lat2))) +360) MOD 360
END FUNCTION

FUNCTION nc_RhumbDir(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    LOCAL dlon, dphi, q AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    dLon = DegToRad(lon2) - DegToRad(lon1)
    dPhi = LOG(TAN(DegToRad(lat2) / 2 + QtrPi) / TAN(DegToRad(lat1) / 2 + QtrPi))
    IF(ABS(dLon) > pi) THEN
      IF(dLon > 0) THEN
         dLon = (TwoPi - dLon) * -1
      ELSE
         dLon = TwoPi + dLon
      END IF
    END IF
    FUNCTION = (RadToDeg(atan2(dPhi,dLon)) + 360) MOD 360
 END FUNCTION

FUNCTION nc_RhumbDist(la1 AS EXT, lo1 AS EXT, la2 AS EXT, lo2 AS EXT) COMMON AS EXT
    LOCAL lat1, lat2 , lon1, lon2, Dist AS EXT
    LOCAL dlon_W, dlon_E, dphi, q AS EXT
    lat1 = DegToRad(la1):lon1 = DegToRad(lo1)
    lat2 = DegToRad(la2):lon2 = DegToRad(lo2)
    dlon_W = ModDbl(TwoPi, (lon2 - lon1))
    dlon_E = ModDbl(TwoPi, (lon1 - lon2))
    dphi = LOG(TAN(lat2 / 2 + QtrPi) / TAN(lat1 / 2 + QtrPi))
    IF (ABS(lat2 - lat1) < 0.00000001) THEN
         q = COS(lat1)
    ELSE
         q = (lat2 - lat1) / dphi
    END IF
    IF (dlon_W < dlon_E) THEN ' Westerly rhumb line is the shortest
          FUNCTION = radToNM(SQR(q ^ 2 * dlon_W ^ 2 + (lat2 - lat1) ^ 2))
    ELSE
          FUNCTION = radToNM(SQR(q ^ 2 * dlon_E ^ 2 + (lat2 - lat1) ^ 2))
    END IF
END FUNCTION

FUNCTION nc_Lat2Lon2 (lat1 AS EXT, lon1 AS EXT, Dist AS EXT, bearing AS EXT, BYREF lat2 AS EXT, BYREF lon2 AS EXT) COMMON AS LONG
   LOCAL la1,lo1,la2,lo2,D,B AS EXT
   la1 = degToRad(lat1)
   lo1 = degToRad(lon1)
   D = Dist/EarthRadiusNM
   B = degtoRad(bearing)
   la2 = arcsin(SIN(la1) * COS(D) + COS(la1) * SIN(D) * COS(B))
   lo2 = lo1 + atan2(COS(D)-SIN(la1) * SIN(la2),SIN(B) * SIN(D) * COS(la1))

   IF ABS(lat1) = 90 THEN lo2 = lo2 + pi
   IF lo2 <-pi THEN lo2 = lo2+twopi
   IF lo2 >  pi THEN lo2 = lo2 -twopi
   lat2 = radToDeg(la2)
   lon2= radToDeg(Lo2)
END FUNCTION

'Distance Conversions
FUNCTION nc_NMToKM(nm AS EXT) COMMON AS EXT
    FUNCTION = nm * 1.852##
END FUNCTION
FUNCTION nc_NMToSM(nm  AS EXT) COMMON AS EXT
    'Convert Nautical Miles to Kilometers
    FUNCTION = nm * 1.150779##
END FUNCTION

  'Lat/Lon Format conversion Functions
'------------------------------------
FUNCTION nc_LatStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Latitude DMS or DM.m string to degrees
    LOCAL sLat AS STRING
    LOCAL deg AS EXT
    LOCAL direction AS LONG
    sLat = ls
    direction = 1
    IF INSTR(sLat,ANY "sS-") THEN direction = -1
    sLat = REMOVE$(sLat, ANY "-sSNn"" ")
    REPLACE ANY "°'" WITH ($TAB & $TAB) IN sLat
    'REPLACE "'" WITH $TAB IN sLat
    FUNCTION = direction * (VAL(PARSE$(sLat,$TAB,1)) + VAL(PARSE$(sLat,$TAB,2))/60 + VAL(PARSE$(sLat,$TAB,3))/3600)
  END FUNCTION

 FUNCTION nc_LonStrToDeg(ls AS STRING) COMMON AS EXT
    'convert Longitude DMS or DM.m string to degrees
    LOCAL sLat AS STRING
    LOCAL deg AS EXT
    LOCAL direction AS LONG
    sLat = ls
    direction = 1
    IF INSTR(sLat,ANY "wW-") THEN direction = -1
    sLat = REMOVE$(sLat, ANY "-wWeE"" ")
    REPLACE "°" WITH $TAB IN sLat
    REPLACE "'" WITH $TAB IN sLat
    FUNCTION = direction * (VAL(PARSE$(sLat,$TAB,1)) + VAL(PARSE$(sLat,$TAB,2))/60 + VAL(PARSE$(sLat,$TAB,3))/3600)
  END FUNCTION

FUNCTION nc_LatDtoDMS(BYVAL D AS EXT) COMMON AS STRING
    LOCAL Deg AS LONG
    LOCAL Mn  AS EXT
    LOCAL Sec AS EXT
    LOCAL Cardinal AS STRING
    Cardinal = "N"
    IF SGN(D)= -1 THEN Cardinal = "S" : D = ABS(D)
    Deg = INT(D)
    Mn  = FRAC(D)* 60
    Sec = ROUND(FRAC(Mn) * 60, 2)
    Mn = INT(Mn)
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn) & "'" & FORMAT$(Sec) & $DQ  & Cardinal
END FUNCTION

FUNCTION nc_LonDtoDMS(BYVAL D AS EXT) COMMON AS STRING
    LOCAL Deg AS LONG
    LOCAL Mn  AS EXT
    LOCAL Sec AS EXT
    LOCAL Cardinal AS STRING
    Cardinal = "E"
    IF SGN(D) = -1 THEN Cardinal = "W" : D = ABS(D)
    Deg = INT(D)
    Mn  = FRAC(D)* 60
    Sec = ROUND(FRAC(Mn) * 60, 2)
    Mn = INT(Mn)
    FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn) & "'" + FORMAT$(Sec) & $DQ & Cardinal
END FUNCTION

FUNCTION nc_LatDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
    LOCAL Deg AS LONG
    LOCAL Mn  AS EXT
    LOCAL Cardinal AS STRING
    Cardinal = "N"
    IF SGN(D)= -1 THEN Cardinal = "S" : D = ABS(D)
    Deg = INT(D)
    Mn  = FRAC(D)* 60
    IF MinDecPl > 0 THEN
        FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn,"0." & STRING$(MinDecPl,"0")) & "'" & Cardinal
    ELSE
        FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(CINT(Mn)) &  "'" & Cardinal
    END IF

END FUNCTION

FUNCTION nc_LonDtoDM(BYVAL D AS EXT,MinDecPl AS LONG) COMMON AS STRING
    LOCAL Deg AS LONG
    LOCAL Mn  AS EXT
    LOCAL Sec AS EXT
    LOCAL Cardinal AS STRING
    Cardinal = "E"
    IF SGN(D) = -1 THEN Cardinal = "W" : D = ABS(D)
    Deg = INT(D)
    Mn  = FRAC(D)* 60
    IF MinDecPl > 0 THEN
        FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(Mn,"0." & STRING$(MinDecPl,"0")) & "'" & Cardinal
    ELSE
        FUNCTION = FORMAT$(Deg) & "°" &  FORMAT$(CINT(Mn)) &  "'" & Cardinal
    END IF
END FUNCTION

'Math Helpers
FUNCTION arcsin(X AS EXT) AS EXT
    FUNCTION = ATN(X / SQR(1 - X * X ))
END FUNCTION

FUNCTION arccos(X AS EXT) AS EXT
    FUNCTION = HalfPi - ATN(X / SQR(1 - X * X ) )
END FUNCTION

FUNCTION atan2(x AS EXT, y AS EXT) AS EXT
  SELECT CASE X
    CASE IS > 0
        FUNCTION = ATN(y / X) '     x>0
    CASE IS = 0
        SELECT CASE y
            CASE IS > 0
                FUNCTION = HalfPi      ' x=0, y>0
            CASE IS < 0
                FUNCTION = - HalfPi     'x=0, y<0
            CASE 0
                FUNCTION = 0      'x = 0, y = 0
        END SELECT
    CASE IS < 0
         SELECT CASE y
            CASE IS >= 0
                FUNCTION = ATN(y / X) + pi ' x<0, y>=0
            CASE IS < 0
                FUNCTION = ATN(y / X) - pi 'x<0, y<0
          END SELECT
    END SELECT
END FUNCTION

FUNCTION ModDbl(X AS EXT, y AS EXT) AS EXT
  'Modulus of floating point values - used in Rhumb Line calculations and Point to Point
  IF y >= 0 THEN
    FUNCTION = y - X * INT(y / X)
  ELSE
    FUNCTION = y + X * (INT(-y / X) + 1)
  END IF
END FUNCTION
'

        Comment

        Previous template Next
        Working...
        X

        We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

        By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

        I Agree