PROGRAM GLOBA%INPUT,OUTPUT,TAPE1,TAPE6#INPUT<                             
C                                                                       001000  
C    *****************************************************************  001100  
C     *                                                                 001200  
C     * GLOBAL COMPUTES THE NORTH, EAST, AND VERTICAL COMPONENTS OF     001300  
C    * GRAVITATIONAL ATTRACTION AT A GIVEN SITE DUE TO A GIVEN TRIAN-   001400  
C    * GULAR SHAPED LOAD HAVING -                                       001500  
C    *                                                                  001600  
C     * THESE COMPONENTS OF ATTRACTION ARE MULTIPLIED BY GIVEN GREENS   002100  
C    * FUNCTIONS TO YIELD THE EFFECT ON GRAVITY AND TILT AT THE         002200  
C    * OBSERVATION SITE                                                 002300  
C    *                                                                  002400  
C    * DATA IS OUTPUTTED FOR INDIVIDUAL POLYGONS, ACCUMULATED FOR       002500  
C    * POLYGONS WITHOUT LIMIT, AND OUTPUTTED AS                         002600  
C    *                                                                  002700  
C    *     %1< AS A TOTAL PERTURBING VECTOR TO BE ADDED TO              002800  
C    *         THE THEORETICAL EARTH-TIDE VECTOR.                       002900  
C     *    %2< AS A RATIO OF THE TOTAL PERTURBING VECTOR TO             003000  
C    *         THE THEORETICAL VECTOR.                                  003100  
C    *     %1< A SPECIFIED AMPLITUDE %HEIGHT OF WATER IN CM.<           001700  
C    *     %2< A SPECIFIED PHASE %RELATIVE TO TRANSIT OF THE MOON AT    001800  
C    *         GREENWICH.                                               001900  
C     *                                                                 002000  
C    *                                                                  003200  
C     ***************************************************************** 003300  
C                                                                       003400  
      DIMENSION IZH%181<,IZ%181<,IXAMP%41<,IXRAT%41<                    003500  
       REAL LSN,MSN,NSN                                                 003600  
      DOUBLE NOTE1,NOTE2                                                003700  
       INTEGER NAME%30<,SKIP%22<                                        003800  
      REAL NINE                                                         003900  
      REAL FV,FN,FE,FVQ,FNQ,FEQ,XT,YT,H,Q,LV,MV,NV,LN,MN,NN,LE,NE,ME,   004000  
     2     L3,M3,N3,L6,L2,M2,N2,L1,M1,N1,XJ,YJ,ZJ,XJJ,YJJ,ZJJ,XS,Y,YS,  004100  
     3     ZS,LL,UJ,VJ,WJ,UJJ,VJJ,M6,WJJ,AJ,PJ,RJ,FJ,CJ,DFU,DFV,DFW,    004200  
     4     DFX,DFY,DFZ,DBV,DBN,DBE,FVC,FNC,FEC,N6,L7,M7,N7,AV,AN,AE,    004300  
     5     PV,PN,PE,AJJ,PJJ,RJJ,FJJ                                     004400  
       REAL XD%8<,YD%8<,X%8<,Y%8<                                       004500  
       REAL  Z%181<, XAMP%41<,ZH%181<,XRAT%41<                          004600  
C                                                                       004700  
C    ****************************************************************** 004800  
C    *                                                                  004900  
C    * DECLARE AND INITIALIZE GREENS FUNCTION FOR GRAVITY %IZ< AND      005000  
C    * FOR TILT %IZH< AT 1 DEGREE INTERVALS. IZ AND IZH ARE BOTH 100    005100  
C    * TIMES THE ACTUAL VALUE.                                          005200  
C    *                                                                  005300  
C    ****************************************************************** 005400  
C                                                                       005500  
      DATA %IZ %I<,I#1,181<                                             005600  
     1/875,651,510,419,360,321,295,276,261,250,241,235,227,221,         005700  
     2215,210,206,202,197,194,190,186,183,179,175,172,168,165,162,      005800  
     3159,156,153,150,148,144,141,138,136,132,130,127,125,123,120,      005900  
     4118,116,114,111,109,107,105,103,101,100,99,98,96,95,94,93,93,     006000  
     592,91,91,91,91,91,91,90,90,90,90,91,91,91,92,92,92,93,93,94,      006100  
     695,95,96,97,97,98,99,100,101,102,102,104,104,105,107,108,109,     006200  
     7110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,      006300  
     8125,126,127,128,129,130,130,131,132,133,133,134,135,135,136,      006400  
     9137,138,139,140,140,141,141,142,143,143,144,144,145,145,146,      006500  
     1147,147,148,148,149,149,149,150,150,150,150,150,151,151,151,      006600  
     2152,153,154,154,154,154,154,154,154,155,155,155,155,155,155,      006700  
     3155,155,155,155,155,155,155,155/                                  006800  
       DATA NINE/1H9/                                                   006900  
C                                                                       007000  
C    ****************************************************************** 007100  
C    *                                                                * 007200  
C    *  FOLLOWING MAY BE ACTIVATED TO ASSIGN TO IZ, FARRELLS GREEN    * 007300  
C    * FUNCTIONS FOR DISPLACEMENT. ACTIVATE BY REMOVING COMMENT.      * 007400  
C    *                                                                * 007500  
C    ****************************************************************** 007600  
C                                                                       007700  
      DATA%IZ%I<,I#1,181<                                               007800  
     1/-336,-130,-94,-75,-61,-52,-47,-43,-40,-38,-36,9*-30,10*-21,10*-9,007900  
     210*1,10*11,10*20,10*21,10*18,10*12,10*4,10*-6,10*-17,10*-29,10*-39008000  
     3,10*-49,10*-57,11*-64/                                            008100  
C                                                                       008200  
C    ****************************************************************** 008300  
C    *                                                                  008400  
C    * IXAMP IS THE TILT GREENS FUNCTION AT 5 KM INTERVALS OUT TO       008500  
C    * 200 KM. AGAIN IXAMP # 100*ACTUAL VALUE.                          008600  
C    *                                                                  008700  
C    ****************************************************************** 008800  
C                                                                       008900  
      DATA %IXAMP%I<,I#1,41<                                            009000  
     1/488,487,485,479,474,460,444,426,409,389,369,358,346,339,331,     009100  
     2330,328,328,328,328,329,329,329,329,329,329,329,329,329,329,      009200  
     3329,326,326,325,324,324,323,323,322,320,318/                      009300  
      DATA %IZH%I<,I#1,181<                                             009400  
     1/440,341,320,282,249,222,202,188,178,170,165,160,158,156,154,     009500  
     2153,152,151,151,150,150,150,149,149,149,149,149,149,149,149,      009600  
     3149,149,148,148,148,148,147,147,146,145,144,144,143,141,140,      009700  
     4139,137,135,133,131,129,127,125,123,120,118,116,114,112,109,      009800  
     5106,104,101,99,97,94,91,89,89,84,81,78,76,72,70,67,65,62,60,      009900  
     658,56,54,52,50,48,46,45,42,40,38,36,35,33,32,31,29,28,27,26,      010000  
     725,24,23,22,21,20,20,19,19,18,18,17,17,16,16,16,16,16,15,15,      010100  
     815,16,16,16,16,16,16,16,17,17,17,17,18,18,18,18,19,19,19,20,      010200  
     920,20,21,21,22,22,23,23,23,24,24,24,25,25,25,26,26,27,27,28,      010300  
     129,29,30,30,31,32,33,33,34,35,36,37,38,39,40,42,45,46,50,58,      010400  
     280,100/                                                           010500  
C                                                                       010600  
C    ****************************************************************** 010700  
C    *                                                                  010800  
C    * IXRAT IS THE GRADIENT OF IXAMP, STILL 100 TIMES THE ACTUAL VALUE 010900  
C    *                                                                  011000  
C    ****************************************************************** 011100  
C                                                                       011200  
      DATA %IXRAT%I<,I#1,41<                                            011300  
     1/0,112,477,585,620,610,560,510,450,360,260,190,90,80,0,0,0,0,0,0, 011400  
     20,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/                        011500  
       COG%X<#ALOG%X<                                                   011600  
       LOG%X<#ALOG%X<                                                   011700  
       PYTHAG%A,B< # SQRT%A**2 & B** 2<                                 011800  
      AMAX%A,B,C<#AMAX1%A,B,C<                                          011900  
      CEIL%X<#INT%X&1.<                                                 012000  
C                                                                       012100  
C    ****************************************************************** 012200  
C    *                                                                  012300  
C    * RAD%X< CONVERTS DEGREES TO RADIANS AND DEG%X< CONVERTS           012400  
C    * RADIANS TO DEGREES.                                              012500  
C    * COSD%X<, SIND%X< CALCULATES COS,SIN OF ANGLE X IN DEGREES.       012600  
C    *                                                                  012700  
C    ****************************************************************** 012800  
C                                                                       012900  
       RAD%X<#X/57.29578                                                013000  
       DEG%X<#X*57.29578                                                013100  
      COSD%X<#COS%RAD%X<<                                               013200  
      SIND%X<#SIN%RAD%X<<                                               013300  
       ATAND%X<#DEG%ATAN%X<<                                            013400  
      PYTHAG2%A,B,C<#SQRT%A**2&B**2&C**2<                               013500  
C                                                                       013600  
C    ****************************************************************** 013700  
C    *                                                                  013800  
C    * INITIALIZE ALL PROGRAM PARAMETERS AND WORK SPACES TO ZERO.       013900  
C    *                                                                  014000  
C    ****************************************************************** 014100  
C                                                                       014200  
      FV#FN#FE#FVQ#FNQ#FEQ#XT#YT#H#Q#LV#MV#LN#MN#0.                     014300  
      NE#ME#L3#M3#N3#L6#L2#M2#N2#L1#N1#XJ#YJ#XJJ#0.                     014400  
      YJJ#ZJJ#XS#Y#YS#ZS#LL#UJ#VJ#VJJ#M6#0.                             014500  
      WJJ#AJ#PJ#RJ#CJ#DFU#DFV#DFX#DFY#DFZ#DBV#DBN#DBE#FVC#0.            014600  
      FNC#FEC#N6#L7#M7#N7#AN#AV#AE#PV#PN#PE#AJJ#PJJ#RJJ#FJJ#0.          014700  
      LICT#0                                                            014800  
      POINT#4.                                                          014900  
C                                                                       015000  
C    ****************************************************************** 015100  
C    *                                                                  015200  
C    * CONVERT GREENS FUNCTIONS TO REAL VALUES TO BE USED IN ALL SUB-   015300  
C    * SEQUENT CALCULATIONS. THE FACTOR 10**-9 IN THE GRADIENT WILL BE  015400  
C    * USED AS A TEST ON WHETHER THE LOCAL OR GLOBAL GREENS FUNCTION    015500  
C    * SHOULD BE USED.                                                  015600  
C    *                                                                  015700  
C    ****************************************************************** 015800  
C                                                                       015900  
      DO 5 J#1,181                                                      016000  
      ZH%J<#IZH%J<                                                      016100  
       Z%J<#IZ%J<                                                       016200  
      Z%J<#Z %J</100                                                    016300  
5     ZH%J<#ZH%J</100                                                   016400  
      DO 6 J#1,41                                                       016500  
      XAMP%J<#IXAMP%J<                                                  016600  
      XRAT%J<#IXRAT%J<                                                  016700  
      XAMP%J<#XAMP%J</100.                                              016800  
6     XRAT%J<#-XRAT%J<*1.0E-9                                           016900  
      CA#6.3783E&8                                                      017000  
C                                                                       017100  
C    ****************************************************************** 017200  
C    *                                                                  017300  
C    * %XT,YT< GIVES THE COORDINATES OF THE OBSERVATION SITE.           017400  
C    * DETAIL # 1 TO USE DDFU AND DDFV COMPUTATION FOR DISTANCES        017500  
C    * LESS THAN 200 KM FROM OBSERVATION SITE. OTHERWISE ZH GREENS      017600  
C    * FUNCTION USED.                                                   017700  
C    *                                                                  017800  
C    * SPECIFY HEIGHT IN CM ONLY WHEN DETERMINING DIRECT ATTRACTION     017900  
C    * EFFECT OF WATER.                                                 018000  
C    *                                                                  018100  
C    ****************************************************************** 018200  
C                                                                       018300  
10     READ 55,%%NAME%I<,I#1,30<,XT,YT,HEIGHT,%SKIP%I<,I#1,22<,IDETAIL< 018400  
55    FORMAT  %30A1,F7.0,F7.0,F6.0 ,22A1,I1<                            018500  
      IF %EOF%6<.NE.0< GO TO  5000                                      018600  
      NPAGE#1                                                           018700  
      REWIND 1                                                          018800  
       SZ0#ZH%1<                                                        018900  
       SZ1#ZH%2<                                                        019000  
       SZ2#ZH%3<                                                        019100  
       SZ3#ZH%4<                                                        019200  
C                                                                       019300  
C    ****************************************************************** 019400  
C    *                                                                  019500  
C    * CALCULATE THEORETICAL RIGID EARTH GRAVITY TIDE %MICROGALS AND    019600  
C    * ARCMILLISECONDS< AND CORRECT LATITUDE FOR POLAR FLATTENING.      019700  
C    *                                                                  019800  
C    ****************************************************************** 019900  
C                                                                       020000  
       QT#YT-%SIND%2.*YT</5.1826<                                       020100  
       F #1.0                                                           020200  
       U#0.0                                                            020300  
       TV # 74.711 * COSD%QT<**2  * F                                   020400  
       TN # 7.8706 * SIND%QT*2.<  * F                                   020500  
      TN#TN*%1.-%SIND%QT<**2</297.<*%1.&2.*%COSD%QT<**2</297.<          020600  
       TE#15.741 * %1.-%SIND%QT<**2</297.<*COSD%QT<*F                   020700  
C                                                                       020800  
C    ****************************************************************** 020900  
C    *                                                                  021000  
C    * CALCULATE VERTICAL, NORTH AND EAST POSITIVE PHASE LAG.           021100  
C    *                                                                  021200  
C    ****************************************************************** 021300  
C                                                                       021400  
       TVP # -2.*XT&U                                                   021500  
       TNP # -2.*XT-180.&U                                              021600  
       TEP # -2.*XT-90.&U                                               021700  
C                                                                       021800  
C    ****************************************************************** 021900  
C    *                                                                  022000  
C    * CALCULATE DIRECTION COSINES AND X,Y,Z COORDINATES OF SITE        022100  
C    * WITH RESPECT TO EARTH CENTERED COORDINATE SYSTEM.                022200  
C    *                                                                  022300  
C    ****************************************************************** 022400  
C                                                                       022500  
       LV # COSD%YT<*COSD%XT<                                           022600  
       MV # COSD%YT<*SIND%XT<                                           022700  
       NV # SIND%YT<                                                    022800  
       LN # -SIND%YT<*COSD%XT<                                          022900  
       MN # -SIND%YT<*SIND%XT<                                          023000  
       NN # COSD%YT<                                                    023100  
      LE#MN*NV-MV*NN                                                    023200  
       ME # -LN*NV&LV*NN                                                023300  
       NE # LN*MV-LV*MN                                                 023400  
       XS # LV*%CA&HEIGHT<                                              023500  
       YS # MV*%CA&HEIGHT<                                              023600  
       ZS # NV*%CA& HEIGHT<                                             023700  
       PRINT 8800                                                       023800  
       PRINT 8801                                                       023900  
      PRINT 8805,%NAME%I<,I#1,30<                                       024000  
8805   FORMAT %*0*30A1<                                                 024100  
      PRINT 8802,%YT,XT<                                                024200  
      PRINT 8400,%SKIP%I<,I#1,22<                                       024300  
      PRINT 8410,%IDETAIL<                                              024400  
 8400 FORMAT%@ SKIP#@,22A1<                                             024500  
 8410 FORMAT%@ IDETAIL#@,I1<                                            024600  
      PRINT 8816,%HEIGHT,IDETAIL<                                       024700  
8816  FORMAT%*HEIGHT#* F7.0,*IDETAIL#* I4<                              024800  
       PRINT 8801                                                       024900  
8830  FORMAT %*0 NR    ZONE     GRAVITY       TILT-NORTH     TILT-EAST  025000  
     2       GRAV    NORTH   EAST   PHASE  DEG  V   H*<                 025100  
109    CONTINUE                                                         025200  
       PRINT 8813,%Z%1<,Z%2<,Z%3<,Z%4<<                                 025300  
       PRINT 8812,%ZH%1<,ZH%2<,ZH%3<,ZH%4<<                             025400  
       PRINT 8815,%TV,TVP,TN,TNP,TE,TEP<                                025500  
      PRINT 8830                                                        025600  
      LICT#LICT&15                                                      025700  
       DDFU#0.                                                          025800  
       DDFV#0.                                                          025900  
       DDFW#0.                                                          026000  
C                                                                       026100  
C    ****************************************************************** 026200  
C    *                                                                  026300  
C    * READ COORDINATES OF POLYGON VERTICES IN GEOGRAPHICAL SYSTEM.     026400  
C    * CONVERT THESE VALUES TO RECTANGULAR COORDINATES IN THE EARTH     026500  
C    * CENTERED SYSTEM. TEST TO ENSURE THAT 2 VERTICES OF SAME TRIANGLE 026600  
C    * ARE NOT EQUAL.                                                   026700  
C    *                                                                  026800  
C    ****************************************************************** 026900  
C                                                                       027000  
      VAC#SAC#EAC#0.                                                    027100  
20     ZH%1< # SZ0                                                      027200  
       ZH%2< # SZ1                                                      027300  
       ZH%3< # SZ2                                                      027400  
       ZH%4< # SZ3                                                      027500  
      I123#0                                                            027600  
      CALL ERRSET%NXXX,100<                                             027700  
   21 NXXO#NXXX                                                         027800  
      READ %1,50<%IRUN,IPART,IH,IQ,IZONE,%YD%J<,XD%J<,J#1,3<<           027900  
      IF %EOF%1<.NE.0< GO TO 12004                                      027950  
      KJ#IOCHEC%1<                                                      028000  
      IF%IZONE.NE.3HE  < GO TO 21                                       ********
      IF%KJ.EQ.0< GO TO 8890                                            028100  
      PRINT 8891                                                        028200  
 8891 FORMAT%30H PARITY ERROR ENCOUNTERED HERE<                         028300  
 8890 CONTINUE                                                          028400  
   48 IF%NXXX.NE.NXXO<GO TO 21                                          028500  
50    FORMAT%I4,I1,I4,I3,A3,3%F8.3,F8.3<<                               028700  
      DO 52 I#1,22                                                      028800  
      IF%SKIP%I<.EQ.1H < GO TO 53                                       028900  
       IF %IZONE.EQ.SKIP%I<< GO TO 21                                   029000  
52     CONTINUE                                                         029300  
53    H#IH                                                              029400  
      Q#IQ                                                              029500  
       H#H*.06664                                                       029600  
      X1#CA*COSD%YD%1<<*COSD%XD%1<<                                     029700  
      X2#CA*COSD%YD%2<<*COSD%XD%2<<                                     029800  
      X3#CA*COSD%YD%3<<*COSD%XD%3<<                                     029900  
      Y1#CA*COSD%YD%1<<*SIND%XD%1<<                                     030000  
      Y2#CA*COSD%YD%2<<*SIND%XD%2<<                                     030100  
      Y3#CA*COSD%YD%3<<*SIND%XD%3<<                                     030200  
      Z1#CA*SIND%YD%1<<                                                 030300  
      Z2#CA*SIND%YD%2<<                                                 030400  
      Z3#CA*SIND%YD%3<<                                                 030500  
      X12#X2-X1  $  Y12#Y2-Y1  $ Z12 # Z2-Z1                            030600  
      X13#X3-X1  $  Y13#Y3-Y1  $ Z13 # Z3-Z1                            030700  
      X32#X12-X13  $  Y32 # Y12-Y13  $ Z32 #Z12-Z13                     030800  
      ZZ1#X12*Y12*Z12                                                   030900  
      ZZ2#X13*Y13*Z13                                                   031000  
      ZZ3#X32*Y32*Z32                                                   031100  
      IF%%ZZ1.EQ.0.<.OR.%ZZ2.EQ.0.<.OR.%ZZ3.EQ.0.<< GO TO 20            031200  
C                                                                       031300  
C    ****************************************************************** 031400  
C    *                                                                  031500  
C    * CALCULATE CENTROID AND DIRECTION COSINES OF THE CENTROID IN      031600  
C    * BOTH THE RECTANGULAR AND GEOGRAPHICAL EARTH CENTRED COORDINATE   031700  
C    * SYSTEM.                                                          031800  
C    *                                                                  031900  
C    ****************************************************************** 032000  
C                                                                       032100  
      XC#%X1&X2&X3</3.                                                  032200  
      YC#%Y1&Y2&Y3</3.                                                  032300  
      ZC#%Z1&Z2&Z3</3.                                                  032400  
      L3#XC/CA  $ M3#YC/CA  $  N3#ZC/CA                                 032500  
C                                                                       032600  
C    ****************************************************************** 032700  
C    *                                                                  032800  
C    * ATAND2 IS SELF CONSTRUCTED INVERSE TANGENT FUNCTION TO GIVE      032900  
C    * ORIENTATION OF AN ARBITRARY VECTOR IN DEGREES FROM THE X AXIS.   033000  
C    *                                                                  033100  
C    ****************************************************************** 033200  
C                                                                       033300  
      CLONG#ATAND2%M3,L3<                                               033400  
      CBASE#PYTHAG%L3,M3<                                               033500  
      CLAT #ATAND2%N3,CBASE<                                            033600  
C                                                                       033700  
C    ****************************************************************** 033800  
C    *                                                                  033900  
C    * CALCULATE GREAT CIRCLE AND DIRECT DISTANCE TO CENTROID FROM      034000  
C    * THE SITE. CONSTRUCT A NORMAL LINE FROM THE CENTROID THROUGH      034100  
C    * THE POLYGON AND FIND ITS DIRECTION COSINES. CONSTRUCT A LINE     034200  
C    * FROM THE SITE WHICH IS PERPENDICULAR TO THE ABOVE NORMAL AND     034300  
C    * FIND ITS LENGTH %NORMAL DISTANCE SITE-TO-TRIANGLE<.              034400  
C    *                                                                  034500  
C    ****************************************************************** 034600  
C                                                                       034700  
      AA#90.-CLAT                                                       034800  
       BB # 90. - YT                                                    034900  
      CC#XT-CLONG                                                       035000  
       CSC # COSD%AA-BB< - SIND%AA< * SIND%BB< * %1. -COSD%CC<<         035100  
      GCDD#ATAND2%SQRT%1.-CSC**2<,CSC<                                  035200  
      GCDC#  GCDD/360.*6.2832*6.3783E&8                                 035300  
      STRTLIN#2.*SIND%GCDD/2.<*CA                                       035400  
      L3#Y13*Z12- Y12*Z13 $ M3#X12*Z13-X13*Z12 $  N3#X13*Y12-X12*Y13    035500  
      LL#SQRT%L3**2 & M3**2 & N3**2<                                    035600  
      L3#L3/LL  $ M3#M3/LL     $N3#N3/LL                                035700  
      WJ#L3*%XC-XS<&M3*%YC-YS<&N3*%ZC-ZS< $ WJ#-WJ                      035800  
      LSN#%XC-XS</STRTLIN  $ MSN#%YC-YS</STRTLIN $NSN#%ZC-ZS</STRTLIN   035900  
C                                                                       036000  
C    ****************************************************************** 036100  
C    *                                                                  036200  
C    * APPLY GREENS FUNCTION CHANGE EFFECT TO NEAR TRIANGLES.           036300  
C    *                                                                  036400  
C    ****************************************************************** 036500  
C                                                                       036600  
      IF%GCDC.GE.2.0E&7.OR.IDETAIL.NE.1< GO TO 65                       036700  
      IF %GCDC.GE.2.0E&7<      GO TO 65                                 036800  
      IBANG#2                                                           036900  
      IDST#%%GCDC*1.0E-5<&2.5</5  $ IDST  # IDST&1                      037000  
      XP#XAMP%IDST<-XRAT%IDST<*GCDC                                     037100  
      XR#XRAT%IDST< $ ZH%1<#ZH%2<#ZH%3<#ZH%4<#1.0                       037200  
      GO TO  66                                                         037300  
65    IBANG#0                                                           037400  
C                                                                       037500  
C    ****************************************************************** 037600  
C    *                                                                  037700  
C    * CALCULATE AREA OF THE TRIANGLE AND THE SIDE OF MAXIMUM           037800  
C    * LENGTH.                                                          037900  
C    *                                                                  038000  
C    ****************************************************************** 038100  
C                                                                       038200  
66    AREAX#Y13*Z12-Y12*Z13                                             038300  
      AREAY#X13*Z12-X12*Z13                                             038400  
      AREAZ#X13*Y12-X12*Y13                                             038500  
      AREA#SQRT%AREAX**2&AREAY**2&AREAZ**2</2.0                         038600  
      SIDE12#PYTHAG2%X12,Y12,Z12<                                       038700  
      SIDE13#PYTHAG2%X13,Y13,Z13<                                       038800  
      SIDE32#PYTHAG2%X32,Y32,Z32<                                       038900  
      SIDEMAX#AMAX%SIDE12,SIDE13,SIDE32<                                039000  
C                                                                       039100  
C    ****************************************************************** 039200  
C    *                                                                  039300  
C    * COMPUTE THE ATTRACTION DUE TO EACH OF THE JMAX LAMINAE AND       039400  
C    * ACCUMULATE THE X,Y,Z COMPONENTS OF THE ATTRACTION IN DFX, DFY,   039500  
C    * DFZ. THE METHOD ARISES FROM - TWO METHODS APPLICABLE TO          039600  
C    * COMPUTERS FOR EVALUATING MAGNETIC ANOMALIES DUE TO FINITE        039700  
C    * THREE DIMENSIONAL BODIES. - MHP BOTT, GEOPHYSICAL PROSPECTING,   039800  
C    * VOL XI, NO. 3, 1963.                                             039900  
C    *                                                                  040000  
C    * THIS METHOD RESTS ON THE APPROXIMATION OF THE OCEAN SURFACE BY   040100  
C    * A SERIES OF PLANAR TRIANGULAR FACES.                             040200  
C    *                                                                  040300  
C    ****************************************************************** 040400  
C                                                                       040500  
      ATTRAC#%AREA/STRTLIN **2<                                         040600  
      DFX1#ATTRAC*LSN                                                   040700  
      DFY1#ATTRAC*MSN                                                   040800  
      DFZ1#ATTRAC*NSN                                                   040900  
      WQUY#POINT*SIDEMAX                                                041000  
      DST2#STRTLIN **2                                                  041100  
      IF%GCDC.LE.WQUY.OR.IBANG.NE.0< GO TO 199                          041200  
      IF %GCDC.LE.WQUY< GO TO 199                                       041300  
      DFX#DFX1                                                          041400  
      DFY#DFY1                                                          041500  
      DFZ#DFZ1                                                          041600  
      W#1H                                                              041700  
       GO TO 12001                                                      041800  
199   CONTINUE                                                          041900  
C                                                                       042000  
C    ****************************************************************** 042100  
C    *                                                                  042200  
C    * INITIALIZE ALL RELEVANT VALUES BEFORE ENTERING INTEGRATION LOOP  042300  
C    *                                                                  042400  
C    ****************************************************************** 042500  
C                                                                       042600  
      XD%4<#XD%1< $ YD%4<#YD%1< $ JMAX#3                                042700  
      DFX#DFY#DFZ#0.                                                    042800  
      W#1H*                                                             042900  
200    DO 12000 J#1,JMAX                                                043000  
           XJJ#CA*COSD%YD%J&1<<*COSD%XD%J&1<<                           043100  
           XJ #CA*COSD%YD%J<<  *COSD%XD%J<<                             043200  
           YJJ#CA*COSD%YD%J&1<<*SIND%XD%J&1<<                           043300  
           YJ # CA*COSD%YD%J<<  *SIND%XD%J<<                            043400  
           ZJJ#CA*SIND%YD%J&1<<                                         043500  
           ZJ #CA*SIND%YD%J<<                                           043600  
           LL #SQRT%%XJJ-XJ<**2 & %YJJ-YJ<**2&%ZJJ-ZJ<**2<              043700  
           L2 #%XJJ-XJ</LL                                              043800  
           M2 #%YJJ-YJ</LL                                              043900  
           N2 #%ZJJ-ZJ</LL                                              044000  
           L6 # M2*N3 -N2*M3                                            044100  
           M6 # -L2*N3&N2*L3                                            044200  
           N6 # L2*M3-M2*L3                                             044300  
           L7 # M3*N6-M6*N3                                             044400  
           M7 # -L3*N6&L6*N3                                            044500  
           N7 # L3*M6 - M3*L6                                           044600  
           UNIT # L7*L7 & M7*M7 & N7*N7                                 044700  
           UNIT # SQRT%UNIT<                                            044800  
           L2 # L7/UNIT                                                 044900  
           M2 # M7/UNIT                                                 045000  
           N2 # N7/UNIT                                                 045100  
           L1 # M2*N3-N2*M3                                             045200  
           M1 # L3*N2-L2*N3                                             045300  
       N1 #L2*M3-M2*L3                                                  045400  
       UJ #L1*%XJ-XS<&M1*%YJ-YS<&N1*%ZJ-ZS<                             045500  
       VJ #L2*%XJ-XS<&M2*%YJ-YS<&N2*%ZJ-ZS<                             045600  
       VJJ#L2*%XJJ-XS<&M2*%YJJ-YS<&N2*%ZJJ-ZS<                          045700  
       IF %UJ< 205,206,207                                              045800  
205    CJ#-1.                                                           045900  
       UJ#-UJ                                                           046000  
       L1#-L1                                                           046100  
       M1#-M1                                                           046200  
       N1#-N1                                                           046300  
       GO TO 208                                                        046400  
206    CJ#0.                                                            046500  
       GO TO 208                                                        046600  
207    CJ#1.                                                            046700  
208    AJ#VJ/UJ                                                         046800  
       AJJ#VJJ/UJ                                                       046900  
       PJ#SQRT%UJ**2 &VJ**2<                                            047000  
       PJJ#SQRT%UJ**2&VJJ**2<                                           047100  
       RJ #SQRT%UJ**2&VJ**2& WJ**2<                                     047200  
       RJJ#SQRT%UJ**2&VJJ**2 &WJ**2<                                    047300  
       FJ# SQRT%1.&AJ**2<                                               047400  
       FJJ#SQRT%1.&AJJ**2<                                              047500  
       DFU#%AJJ*COG%%RJJ&PJJ</ABS%WJ<</FJJ<-.5*COG%RJJ&VJJ<&.5*         047600  
     2     COG%RJJ-VJJ< -AJ*COG%%RJ&PJ</ABS%WJ<</FJ& .5* COG%RJ&VJ<     047700  
     3     -.5*COG%RJ-VJ<                                               047800  
       DFV#-1.*COG%%RJJ&PJJ</ABS%WJ<</FJJ & 1.*COG%%RJ&PJ</ABS%WJ<</FJ  047900  
       DFW# -%WJ/ABS%WJ<<*ATAN2%AJJ*%RJJ-ABS%WJ<<, RJJ&%AJJ**2<*ABS%WJ< 048000  
     2       <&%WJ/ABS%WJ<<*ATAN2%AJ*%RJ-ABS%WJ<<,%RJ&%AJ**2<*ABS%WJ<<< 048100  
      IF %IBANG.NE.2< GO TO 215                                         048200  
       DDFU#UJ*%ATAN2%VJJ,UJ<-ATAN2%VJ,UJ<<                             048300  
       DDFV#UJ*%COG%PJJ<-COG%PJ<<                                       048400  
300    DFU #%DFU*XP<&%DDFU*XR<                                          048500  
       DFV #%DFV*XP<&%DDFV*XR<                                          048600  
215    DFW#-DFW                                                         048700  
       DFU#-DFU                                                         048800  
       DFV#-DFV                                                         048900  
       DFX#DFX&CJ*%L1*DFU&L2*DFV&L3*DFW<                                049000  
       DFY#DFY&CJ*%M1*DFU&M2*DFV&M3*DFW<                                049100  
       DFZ#DFZ&CJ*%N1*DFU&N2*DFV&N3*DFW<                                049200  
C                                                                       049400  
12000 CONTINUE                                                          049300  
C    ****************************************************************** 049500  
C    *                                                                  049600  
C    * RESOLVE COMPONENTS OF ATTRACTION DUE TO THE ENTIRE POLYGON       049700  
C    * ALONG THE VERTICAL, NORTH AND EAST AXES THROUGH THE SITE AND     049800  
C    * ACCUMULATE SEPARATELY                                            049900  
C    *                                                                  050000  
C    *     %1< THE IN-PHASE COMPONENTS %FV,FN,FE<                       050100  
C    *     %2< THE QUADRATURE COMPONENTS %FVQ,FNQ,FEQ< FOR ALL          050200  
C    *         TRIANGLES.                                               050300  
C    *                                                                  050400  
C    * NOTE THAT THESE VECTORS ARE ORIGINALLY IN BOTTS %U,V,W<          050500  
C    * COORDINATE SYSTEM IN WHICH THE W-AXIS IS PERPENDICULAR TO THE    050600  
C    * PLANE OF THE POLYGON, THE U-AXIS IS PARALLEL TO THE SIDE OF THE  050700  
C    * POLYGON WHICH IS UNDER CONSIDERATION, AND THE V-AXIS IS          050800  
C    * PRE-DETERMINED BY THE U,W POSITIONS.                             050900  
C    *                                                                  051000  
C    ****************************************************************** 051100  
C                                                                       051200  
12001  DBV#DFX*LV&DFY*MV&DFZ*NV                                         051300  
       C1GDL # %4.848 * .98<                                            051400  
       DRB#%4.*CA*CA/DST2<-1.                                           051500  
       DRB# ABS%DRB<&.0001                                              051600  
       DBV#DBV*Z%KR<                                                    051800  
       FV # DBV*H*COSD%Q<&FV                                            051900  
       KR# ABS%2.*ATAND%1./SQRT%DRB<<<&1.5                              051700  
       FVQ# DBV*H*SIND%Q<&FVQ                                           052000  
       DBN# DFX*LN& DFY*MN & DFZ*NN                                     052100  
       DBN# DBN*ZH%KR</C1GDL                                            052200  
       FN # DBN*H*COSD%Q<&FN                                            052300  
       FNQ# DBN*H*SIND%Q<&FNQ                                           052400  
       DBE# DFX*LE&DFY*ME&DFZ*NE                                        052500  
       DBE# DBE*ZH%KR</C1GDL                                            052600  
       FE # DBE*H*COSD%Q<&FE                                            052700  
       FEQ# DBE*H*SIND%Q<&FEQ                                           052800  
C                                                                       052900  
C    *                                                                  053100  
C    * OUTPUT NET AMPLITUDE AND PHASE IN MICROGALS AND DEGREES          053200  
C    ****************************************************************** 053000  
C    *                                                                  053300  
C    ****************************************************************** 053400  
C                                                                       053500  
      VAC#VAC&DBV*H $ SAC#SAC&DBN*H  $EAC#EAC&DBE*H                     053600  
C****** NEXT CARD CAUSES ALL CONTRIBUTIONS TO BE OUTPUTTED              053700  
      GO TO 12002                                                       053800  
       IF %VAC.LE.-.001< GO TO 12002                                    053900  
      VAC#SAC#EAC#0.                                                    054000  
      GO TO 20                                                          054100  
12002 IF %IPART.NE.0< GO TO 20                                          054200  
12003  AV#PYTHAG%FV,FVQ<                                                054300  
       IF %AV.NE.0.< PV # ATAND2%FVQ,FV<                                054400  
       AN # SQRT%FN**2 & FNQ**2<                                        054500  
       IF %AN.NE.0<  PN # ATAND2%FNQ,FN<                                054600  
      AE#PYTHAG%FE,FEQ<                                                 054700  
       IF %AE.NE.0.< PE # ATAND2%FEQ,FE<                                054800  
       IV#PV $ JV#PN $ KV#PE                                            054900  
12005  IF %LICT.LE.55< GO TO 12006                                      055100  
      KRX#KR-1                                                          055000  
       LICT#3                                                           055200  
       NPAGE#NPAGE&1                                                    055300  
       PRINT 8895,NPAGE                                                 055400  
8895   FORMAT %*1*60X,*PAGE *I4<                                        055500  
       PRINT 8830                                                       055600  
       GO TO 12005                                                      055700  
12006  LICT#LICT&1                                                      055800  
      PRINT 8850,%IRUN,IPART,IZONE,AV,IV,AN,JV,AE,KV,VAC,SAC,           055900  
     2EAC,W,IQ,KRX,IZ%KR<,IZH%KR<<                                      056000  
8850  FORMAT %* *I4,I2,1X,A3,3%F9.3*%*I4*<*<,5X,3F8.4,X,A1,X,I5,I7,2I4< 056100  
69    FORMAT %* TRACE COUNTER VALUE IS*I4<                              056200  
      VAC#SAC#EAC#0.                                                    056300  
       GO TO 20                                                         056400  
C                                                                       056500  
C    ****************************************************************** 056600  
C    *                                                                  056700  
C    * FINISHED WITH POLYGONS. HERE OUTPUT ACCUMULATED DATA.            056800  
C    *                                                                  056900  
C    ****************************************************************** 057000  
C                                                                       057100  
12004 REWIND 1                                                          057200  
       AV# AV/TV                                                        057300  
       AN# AN/TN                                                        057400  
       AE# AE/TE                                                        057500  
       TV# 1.16                                                         057600  
       TN# .700                                                         057700  
       TE# TN                                                           057800  
       QV# PV-TVP                                                       057900  
       IQV# %QV&180.</360.                                              058000  
       QV # QV-%IQV*360<                                                058100  
       QN #  PN-TNP                                                     058200  
       IQN# %QN&180.</360.                                              058300  
       QN #  QN-%IQN*360<                                               058400  
       RVX#  TV*COSD%TVP<                                               058500  
       RVY#  TV*SIND%TVP<                                               058600  
       QE# PE-TEP                                                       058700  
       IQE# %QE&180.</360.                                              058800  
       QE #QE- %IQE*360<                                                058900  
       RAVX # AV*COSD%PV<                                               059000  
       RAVY # AV*SIND%PV<                                               059100  
       RVX  # RAVX&RVX                                                  059200  
       RVY  # RAVY&RVY                                                  059300  
       IV#QV $ JV#QN $ KV#QE                                            059400  
C                                                                       059500  
C    ****************************************************************** 059600  
C    *                                                                  059700  
C    * IV, JV, KV ARE PHASE LAGS IN DEGREES OF THE PERTURBATIONS        059800  
C    * CAUSED BY THE LOADING AND ATTRACTIVE EFFECT OF THE OCEANS ON     059900  
C    * AN ELASTIC DEFORMABLE EARTH. AV, AN, AE ARE THE AMPLITUDES OF    060000  
C    * THE COMPONENTS OF THE PERTURBATIONS.                             060100  
C    *                                                                  060200  
C    ****************************************************************** 060300  
C                                                                       060400  
      PRINT 8860,%IRUN,IPART,IZONE,AV,IV,AN,JV,AE,KV<                   060500  
8860  FORMAT %*0*I4,I2,X,A3,3%F9.3*%*I4*<*<,*    PERTURBING VECTOR*<    060600  
      AV#PYTHAG%RVX,RVY<                                                060700  
       PV#  ATAND2%RVY,RVX<                                             060800  
       RNX # TN* COSD%TNP<                                              060900  
       RNY # TN* SIND%TNP<                                              061000  
       RANX# AN* COSD%PN<                                               061100  
       RANY# AN* SIND%PN<                                               061200  
       RNX # RANX&RNX                                                   061300  
       RNY # RANY&RNY                                                   061400  
       AN  # SQRT%RNX**2 &RNY**2<                                       061500  
       PN  # ATAND2%RNY,RNX<                                            061600  
       REX # TE*COSD%TEP<                                               061700  
       REY # TE*SIND%TEP<                                               061800  
       RAEX# AE*COSD%PE<                                                061900  
       RAEY# AE*SIND%PE<                                                062000  
       REX # RAEX&REX                                                   062100  
       REY # RAEY&REY                                                   062200  
       AE  # PYTHAG%REX,REY<                                            062300  
       PE#ATAND2%REY,REX<                                               062400  
       PV#PV-TVP                                                        062500  
       IPV#%PV&180.</360.                                               062600  
       PV # PV-%IPV*360<                                                062700  
       PN # PN-TNP                                                      062800  
       IPN#%PN&180</360.                                                062900  
       PN # PN-%IPN*360<                                                063000  
       PE # PE-TEP                                                      063100  
       IPE# %PE&180.</360.                                              063200  
       PE # PE-%IPE*360<                                                063300  
       IV#PV $ JV#PN $ KV#PE                                            063400  
C                                                                       063500  
C    ****************************************************************** 063600  
C    *                                                                  063700  
C    * PV,PN,PE ARE NOW PHASE LAGS OF CALCULATED RESULTANT DIMINISHING  063800  
C    * %TILT< OR AMPLIFICATION %GRAVITY< FACTORS RELATIVE TO THAT       063900  
C    * WHICH WOULD BE OBSERVED ON A NON-YIELDING OCEANLESS EARTH.       064000  
C    *                                                                  064100  
C    ****************************************************************** 064200  
C                                                                       064300  
      PRINT 8870,%IRUN,IPART,IZONE,AV,IV,AN,JV,AE,KV<                   064400  
8870  FORMAT %* *I4,I2,X,A3,3%F9.3*%*I4*<*<,*    RATIO VECTOR*<         064500  
      FV#FVQ#FN#FNQ#FE#FEQ#0.                                           064600  
       GO TO 10                                                         064700  
5000  CONTINUE                                                          064800  
      PRINT 8892                                                        064900  
6000   STOP                                                             065000  
8892   FORMAT %*0&&&&N O R M A L   E N D    O F    J O B&&&&&*<         065100  
8800  FORMAT %*1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&*<   065200  
8801  FORMAT %* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&*<   065300  
8802  FORMAT %5H0LAT#,F6.2,2X,6H LONG#,F6.2<                            065400  
8803  FORMAT %*0&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&*<   065500  
8812   FORMAT %* ZH%0<#*F5.3* ZH%1<#*F5.3* ZH%2<#*F5.3* ZH%3<#*F5.3<    065600  
8813   FORMAT %*0Z%0<#*F5.3* Z%1<#*F5.3* Z%2<#*F5.3* Z%3<#*F5.3<        065700  
8815   FORMAT %* TV#*F8.3,3X,*TVP#*F8.3,3X,*TN#*F8.3,3X,*TNP#*          065800  
     2     F8.3,3X,*TE#*F8.3,3X,*TEP#*F8.3<                             065900  
9000     FORMAT %5%6E18.12,/<<                                          066000  
       END                                                              066100  
      FUNCTION ATAND2%X,Y<                                              066200  
      ENTRY OTAN2                                                       066300  
         IF %Y.GT.0.< ATAND2#ATAN2%X,Y<*57.29578                        066400  
         IF %Y.EQ.0.< ATAND2#90.                                        066500  
         IF %Y.EQ.0..AND.X.LT.0.< ATAND2#-90.                           066600  
         IF %Y.LT.0..AND.X.GE.0.< ATAND2#ATAN2%X,Y<*57.29578&180.       066700  
         IF %Y.LT.0..AND.X.LT.0.< ATAND2#ATAN2%X,Y<*57.29578 -180.      066800  
         ATAND2#AMOD%ATAND2,180.0<                                      066900  
       RETURN                                                           067000  
       END                                                              067100  
00                                                                             
ST. JOHN N.B. %M2 DISPLAC<    293.950 45.267                                    
YARMOUTH N.S. %M2 DISPLAC<    293.883 43.833                                    
DIGBY N.S. %M2 DISPLAC<       294.233 44.617                                    
GLACE BAY N.S. %M2 DISPLAC<   300.050 46.200                                    
MONCTON N.B. %M2 DISPLAC<     295.217 46.100                                    
17                                                                             
00                                                                             
00