Re: The Great Circle

["Bruce Odum" <bodum@xxxxxxxxxxxx>]

Thanks for all your help on this. What I found you do have to have the
arcosin routine defined with all the inputs  but not for sin and cos.  I
placed the acs routine into another service program we use here for geo
functions.  Here is a working copy of the The Great Circle calc that works
in free format on the AS400.

     H Option(*SrcStmt : *NoDebugIO)

     H Dftactgrp( *No )

     H Actgrp( *Caller )

     H Bnddir( 'QC2LE')

      *Assumptions

      *The circumference of the earth in miles = 3954

      *

      *This program is based on The Great Circle Formula

      *d=acos(sin(lat1)*sin(lat2)+cos(lat1)*cos(lat2)*cos(lon1-lon2))

      *

*The as400 math functions work using Raidans so you have to      convert

      *decimal to raidans.

      *The formula for converting decimal to raidans is

      * rad = dec * (pi/180)

      *

     dpi               c                   3.14159265

     dradius           c                   3954

      *Point A

     dlat1             s              8f

     dlong1            s              8f

      *Point B

     dlat2             s              8f

     dlong2            s              8f

      * Result cosin Float long Point A & B

     dtheta            s              8f

      * Work Fields

     ddist             s              8f

     dmiles            s             10s 5

     dfc               s             12a



      *Point A

     d In_1latDeg      s              2s 0 inz(34)

     d In_1latMin      s              2s 0 inz(59)

     d In_1latSec      s              2s 0 inz(43)

     d In_1lonDeg      s              3s 0 inz(-085)

     d In_1lonMin      s              2s 0 inz(-12)

     d In_1lonSec      s              2s 0 inz(-26)

      *Point B

     d In_2latDeg      s              2s 0 inz(33)

     d In_2latMin      s              2s 0 inz(59)

     d In_2latSec      s              2s 0 inz(11)

     d In_2lonDeg      s              3s 0 inz(-118)

     d In_2lonMin      s              2s 0 inz(-09)

     d In_2lonSec      s              2s 0 inz(-27)



      *Prototypes for math functions

     dsin              PR             8f   Extproc('sin')

     din                              8f   value

     dcos              PR             8f   Extproc('cos')

     din                              8f   value

     dacs              PR             8f   Extproc('acs')

     din                              8f   value

     dfc                             12a   value



      /free



        //Convert Degrees, Minutes, Seconds to Decimal Degrees

        // Point A

        lat1 = %float(In_1latdeg+(In_1latmin/60)+(In_1latsec/3600));

        long1 = %float(In_1londeg+(In_1lonmin/60)+(In_1lonsec/3600));

        // Point B

        lat2 = %float(In_2latdeg+(In_2latmin/60)+(In_2latsec/3600));

        long2 = %float(In_2londeg+(In_2lonmin/60)+(In_2lonsec/3600));



        //Convert Decimal Degrees To Raidans

        // Point A

        lat1 = lat1 * (pi/180);

        long1 = long1 * (pi/180);

        // Point B

        lat2 = lat2 * (pi/180);

        long2 = long2 * (pi/180);



        //Convert Raidans To Miles

        theta = long1 - long2;

        dist = (sin(lat1)*sin(lat2))+

                (cos(lat1)*cos(lat2)*cos(theta));

        dist = radius * acs(dist:fc);



        //Convert Float To Decimal

        miles = %dec(dist:10:5);



       *inlr = *on;

      /end-free



      **********************************************************************

      * Prototype for acs  Arccosine

      **********************************************************************



     P ACS             B                   EXPORT

     D ACS             PI             8F

     D  IN                            8F   Value

     D  FC                           12A   Value

     D

     D OUT             S              8F



     C                   CallB     'CEESDACS'

     C                   PARM                    IN

     C                   PARM                    OUT

     C                   PARM                    FC

     C                   return    OUT

     P ACS             E