C GEM8 . BY R. SOSA. T. * C GEM8 .- &ROGRAM TO COMPUTE GRAVITY ANOMALY, DEFLECTION OF THE THE * C VERTICAL AND GEOIDAL HEIGHTS. GEOCENTRIC OR GEODESIC. * DIMENSION XLAT(64),XLON(64) DIMENSION XX(64),YY(64),XSI(64),ETA(64),UND(64),DG(64) C CONSTANT TO TRANSFORM FROM GEM8 WITH NORMAL ELLIPSIDO GRS1967 TO CGS77 A67=6378130.0 DA=0.0 DF= 0.0 RHO=90.0/ARSIN(1.0) 0000003 SCRD=3.24E05/ARSIN(1.0) DXO= 0. DYO= 0. DZO= 0. N=3 DO 10 I=1,N READ(5,100) XLAT(I),XLON(I) XX(I)=XLAT(I)/RHO YY(I)=XLON(I)/RHO 10 CONTINUE CALL NDEVG(XX,YY,0,DG,XSI,ETA,UND,N,25) C TRANSFORMATION OF FI,LAM,XSI,ETA,N, FROM GEM8-GRS1967 C TO CGS77 DO 50 I=1,N COSF=COS(XX(I)) SENF=SIN(XX(I)) COSL=COS(YY(I)) SINL=SIN(YY(I)) UDG=-COSF*COSL*DXO-COSF*SINL*DYO-SENF*DZO-DA+A67*DF*SENF**2 UN77=UND(I)-UDG XLATI=XX(I)*RHO XLONG=YY(I)*RHO DXSI=(SENF*COSL*DXO+SENF*SINL*DYO-COSF*DZO+2*A67*SENF*COSF*DF)*SCR *D/A67 DETA=(SINL*DXO-COSL*DYO)*SCRD/A67 XSI77=XSI(I)+DXSI ETA77=ETA(I)+DETA WRITE (6,900) XLATI,XLONG,DG(I),XSI77,ETA77,UN77 50 CONTINUE 100 FORMAT(3X,F10.7,2X,F11.7) 900 FORMAT(3X,2F12.3,3X,F6.2,2X,2F7.2,2X,F6.2) STOP END SUBROUTINE NDEVG (XLT,XLN,IDG,DG,XIGC,ETAGC,UNDGC,NRP,NDO) 00000230 C...THIS IS A MODIFICATION OF SUBROUTINE GEOID PREPARED BY G. LACHAPELLE00000240 C...IN JANUARY 1976 - GEODETIC SURVEY OF CANADA. 00000250 C...MODIFIED IN MARCH 1976. 00000260 C MODIFIED BY R. SOSA. T. IN NOV. L 1976 C...WHEN IDG = 1, ONLY THE GRAVITY ANOMALIES ARE CALCULATED. 00000270 C...WHEN IDG IS GREATER THAN 1, XIGC, ETAGC AND UNDGC ONLY ARE CALCULATE00000280 C...WHEN IDG = 0, ALL QUANTITIES ARE CALUATED, I.E. GRAVITY ANOMALIES, 00000290 C...XIGC, ETAGC AND UNDGC. 00000300 DIMENSION XLT(1),XLN(1),XIGC(1),ETAGC(1),UNDGC(1),DG(1) 00000310 DIMENSION XJ(348),XK(348),P(26,26),PS(26) 00000320 DIMENSION XJ1(72),XJ22(72),XJ3(72),XJ4(72),XJ5(60) 0000032 DIMENSION XK1(72),XK2(72),XK3(72),XK4(72),XK5(60) 00000322 EQUIVALENCE (XJ(1),XJ1(1)),(XJ(73),XJ22(1)),(XJ(145),XJ3(1)) 0000032 EQUIVALENCE (XJ(217),XJ4(1)),(XJ(289),XJ5(1)) 00000324 EQUIVALENCE (XK(1),XK1(1)),(XK(73),XK2(1)),(XK(145),XK3(1)) 00000325 EQUIVALENCE (XK(217),XK4(1)),(XK(289),XK5(1)) 00000326 C...XJ AND XK CONTAIN THE HARMONIC COEFFICIENTS OF GSFC/GEM8 FROM 00000330 C...DEGREE AND ORDER (2,0) TO (25,25). 00000340 C...NDO IS THE DEGREE UP TO WHICH THE QUANTITIES ARE EVALUATED. 00000350 DATA KKK/1/ 00000360 DATA XJ1/ 00000370 * -.48416457E-03, -.65904683E-10, .24344639E-05, .95840799E-06, 00000380 * .20317097E-05, .89773468E-06, .71617317E-06, .54000873E-06, 00000390 * -.53737025E-06, .34728474E-06, .98535956E-06, -.19541782E-06, 00000400 * .68075479E-07, -.64662051E-07, .66179304E-06, -.46166854E-06, 00000410 * -.28225178E-06, .15251283E-06, -.15047592E-06, -.71387246E-07, 00000420 * .52391390E-07, .51628335E-07, -.10200065E-06, -.25895100E-06, 00000430 * .10917899E-07, .93294375E-07, .27161595E-06, .32054255E-06, 00000440 * .23392685E-06, -.26727077E-06, -.83789523E-08, -.34924934E-06, 00000450 * .13335744E-07, .50113356E-07, .19619185E-07, .73626658E-07, 00000460 * -.16224098E-07, -.23406383E-06, -.20980412E-07, -.62770748E-07, 00000470 * .76345991E-07, -.10894213E-06, .26192039E-07, .15487454E-06, 00000480 * .37283585E-07, -.17539132E-06, -.89588104E-08, .62603293E-08, 00000490 * .51385465E-07, -.76544664E-07, .24320286E-06, -.48214259E-07, 00000500 * .54043016E-07, .90085984E-07, -.66253578E-07, -.31577033E-07, 00000510 * -.11134293E-06, -.61002420E-07, -.10641216E-07, .17470419E-07, 00000520 * .46126335E-07, .12372667E-06, .10127194E-06, -.44360243E-07, 00000530 * .18161790E-07, .13969917E-07, -.54572069E-07, -.44774075E-07, 00000540 * .35804698E-07, -.22943804E-07, .12905411E-07, .11638281E-07/ 00000550 DATA XJ22/ * -.31851072E-07, -.46128085E-07, .62906820E-07, .37693998E-07, 00000570 * -.72038713E-07, -.18374966E-07, .57564062E-07, -.62778147E-07, 00000580 * .42843474E-07, .37942436E-08, -.33345994E-07, -.15361575E-07, 00000590 * .27623797E-07, -.32605983E-08, .14244879E-07, -.50456838E-08, 00000600 * .36529692E-07, -.26269797E-07, .14395154E-07, -.18724380E-07, 00000610 * -.40313109E-08, .70465963E-07, -.66794351E-07, .22580088E-08, 00000620 * -.27417993E-08, .12931325E-07, .35325301E-07, -.30029503E-07, 00000630 * -.30919509E-07, -.58086001E-07, -.24756670E-07, -.15511748E-08, 00000640 * -.29410605E-07, .35360826E-07, -.78129530E-08, .34952231E-07, 00000650 * -.25180678E-07, .27139871E-07, -.17233237E-07, .16374111E-07, 00000660 * .36143405E-07, .29167047E-07, .12455449E-07, .32512960E-07, 00000670 * -.51879708E-07, .10164637E-07, .11297416E-07, .96450271E-09, 00000680 * .25147538E-07, -.35845510E-07, .10032393E-07, .44365368E-07, 00000690 * .60354469E-07, -.17310067E-07, -.32183218E-08, -.33276524E-08, 00000700 * .88881016E-08, -.32965914E-07, -.23183007E-07, .52392794E-08, 00000710 * -.24005189E-07, -.31129748E-08, .13632648E-07, -.84787406E-08, 00000720 * -.17273587E-07, .37294877E-07, -.32595636E-07, -.15460324E-08, 00000730 * -.16633744E-08, -.25431616E-07, -.85540727E-08, .10884235E-07/ 00000740 DATA XJ3/ 00000750 * .30118947E-08, .16396627E-07, .14276602E-07, -.15800084E-07, 00000760 * .87493962E-08, -.29445574E-07, .10823230E-07, -.27281946E-07, 00000770 * -.35605524E-07, -.31961718E-09, -.17850022E-07, -.20854007E-07, 00000780 * -.63493751E-07, .32509993E-07, .26112441E-07, -.43518883E-07, 00000790 * .55351364E-08, .66124781E-08, .27667201E-07, .17532346E-07, 00000800 * -.16908144E-07, .24200048E-08, -.25799570E-07, -.45759110E-07, 00000810 * .81420159E-08, -.13021423E-08, .46291135E-08, .22638382E-07, 00000820 * .98136628E-08, .12663596E-07, -.12581258E-07, .14263804E-07, 00000830 * .15657410E-07, .89024840E-08, .31956709E-07, -.26871315E-07, 00000840 * -.26289619E-07, -.10610044E-07, -.12351643E-07, -.61350862E-07, 00000850 * .44921038E-07, .67880870E-08, -.15084414E-07, .16404301E-08, 00000860 * -.39788086E-07, .46931036E-07, .58853395E-08, -.34240830E-08, 00000870 * -.22846609E-07, .38852442E-07, .71225089E-08, .23783523E-07, 00000880 * -.16379060E-07, -.28426400E-07, .30471193E-07, -.20141679E-07, 00000890 * -.85943388E-08, -.53052813E-09, -.88489197E-08, -.81249156E-08, 00000900 * .42397813E-07, .65956946E-07, -.31353961E-07, .18098927E-07, 00000910 * -.15843895E-07, -.23000906E-07, -.30464347E-07, -.23542795E-07, 00000920 * -.19461222E-07, .43967914E-07, -.16607321E-07, -.16831960E-07/ 00000930 DATA XJ4/ 00000940 * .55787834E-07, -.30730502E-08, .22571470E-07, -.76784259E-08, 00000950 * .16022717E-07, .21907838E-07, -.25023661E-07, -.28710966E-08, 00000960 * -.24611905E-07, -.37743655E-08, .35952492E-08, .20486829E-08, 00000970 * .22563821E-08, -.52088802E-08, .43854953E-08, .33330971E-07, 00000980 * .20304569E-07, .27446261E-08, .22970052E-08, -.20870222E-07, 00000990 * .96754647E-08, -.87329016E-08, -.17184500E-07, .22029315E-08, 00001000 * -.64812204E-08, -.18754324E-07, .13228430E-07, .27151833E-07, 00001010 * .48770933E-08, .10917660E-07, .35500917E-07, -.40281128E-07, 00001020 * -.36407405E-08, .48768159E-09, .82154199E-09, .19022473E-07, 00001030 * .13591425E-07, .22253470E-07, -.17467249E-08, .89798256E-08, 00001040 * -.44206391E-08, .82554189E-08, .10605834E-09, .96170164E-08, 00001050 * -.23759111E-08, -.13309200E-08, -.14177371E-07, -.11425533E-07, 00001060 * .98949431E-08, -.70240573E-08, -.39193990E-07, .40805833E-07, 00001070 * .15998187E-07, .66537767E-08, .55551529E-08, -.11547659E-07, 00001080 * -.38676597E-08, -.24107292E-07, .77589819E-08, .20255940E-07, 00001090 * -.33926997E-07, -.13134660E-07, .58573112E-08, -.36539318E-07, 00001100 * -.56608767E-08, -.76502830E-08, .27094727E-08, -.10761367E-08, 00001110 * -.69182843E-08, .23872483E-08, -.62051167E-08, -.75774516E-09/ 00001120 DATA XJ5/ 00001130 * .17464114E-07, .54346290E-07, -.18148269E-07, .87410516E-08, 00001140 * .20011549E-07, -.28526804E-07, .27445553E-07, .56262534E-08, 00001150 * -.10501047E-07, -.26397521E-08, -.68336427E-08, -.35007657E-07, 00001160 * -.26267505E-08, .60548609E-08, -.34298998E-07, -.28976278E-07, 00001170 * .14327301E-07, .56314043E-08, -.21398977E-07, .12934276E-07, 00001180 * .16789554E-07, .12944369E-07, -.98291036E-08, -.27330010E-07, 00001190 * -.20760793E-07, .12041919E-07, -.29027694E-07, .15891795E-07, 00001200 * -.27899261E-07, -.12593093E-07, -.27081596E-07, -.21742268E-07, 00001210 * .95731033E-08, -.40017617E-08, -.25778654E-08, .18897289E-07, 00001220 * .88841959E-08, -.50817452E-09, .25031419E-07, .10693227E-08, 00001230 * .23688996E-07, -.15940949E-07, .44416041E-07, -.10313570E-07, 00001240 * .87563135E-08, -.41869675E-08, -.33295684E-07, .16589714E-07, 00001250 * -.27264126E-07, -.46549297E-08, .67633431E-08, -.69636204E-08, 00001260 * -.50683342E-08, -.48254043E-08, -.31723452E-08, .11142612E-07, 00001270 * .43756253E-08, .22333831E-07, .25768806E-07, -.34232691E-10/ 00001280 DATA XK1/ 00001290 * 0. , .28596622E-09, -.13953377E-05, 0. , 00001300 * .24958865E-06, -.62327971E-06, .14169100E-05, 0. , 00001310 * -.47378360E-06, .66568066E-06, -.19669998E-06, .30529261E-06, 00001320 * 0. , -.83546130E-07, -.32023249E-06, -.20451010E-06, 00001330 * .51797039E-07, -.68077903E-06, 0. , .29988966E-07, 00001340 * -.36402170E-06, -.26051543E-09, -.45621160E-06, -.52911341E-06, 00001350 * -.25933512E-06, 0. , .99234484E-07, .94916755E-07, 00001360 * -.21755139E-06, -.12430885E-06, .37087402E-07, .12662232E-06, 00001370 * -.61849276E-09, 0. , .42128515E-07, .70424990E-07, 00001380 * -.96306024E-07, .67965554E-07, .80659821E-07, .29533565E-06, 00001390 * .78640103E-07, .11058320E-06, 0. , .17023853E-07, 00001400 * -.28023397E-07, -.62047241E-07, .12548987E-07, -.53178018E-07, 00001410 * .19300207E-06, -.64006860E-07, -.54282194E-08, .85612066E-07, 00001420 * 0. , -.12011047E-06, -.51180147E-07, -.13871041E-06, 00001430 * -.88912577E-07, -.45131188E-07, -.95647264E-07, -.48912207E-08, 00001440 * -.93491900E-07, -.48776044E-07, -.23315205E-07, 0. , 00001450 * -.16415786E-08, -.11193309E-06, -.10903728E-06, -.90381543E-07, 00001460 * .10099014E-06, .15138741E-07, -.77392163E-07, .67892065E-07/ 00001470 DATA XK2/ 00001480 * .65944928E-07, -.45852969E-08, -.46232204E-07, 0. , 00001490 * -.56073920E-07, .29323147E-07, .23035505E-07, -.25361346E-07, 00001500 * -.24636926E-08, .17840840E-07, .40311858E-07, .12288035E-07, 00001510 * .57667460E-08, .47067501E-07, -.45859147E-08, -.12135830E-07, 00001520 * 0. , .39123925E-07, -.35512289E-07, .63576078E-07, 00001530 * -.12569089E-07, .54017268E-07, .11454704E-07, .39026721E-08, 00001540 * .17472807E-07, .70025914E-07, -.33709957E-07, .47033459E-08, 00001550 * .89281282E-07, .68139047E-07, 0. , .37198750E-07, 00001560 * -.26535437E-08, -.50157460E-08, -.88621080E-08, -.45385837E-07, 00001570 * .58760767E-08, .55919557E-08, -.26659622E-07, .63585923E-08, 00001580 * -.68600259E-08, -.38019765E-07, -.31333142E-07, .40347860E-07, 00001590 * -.47130415E-08, 0. , .20946604E-08, -.47892073E-07, 00001600 * .30228489E-07, -.13670306E-07, .52799941E-07, -.58876251E-07, 00001610 * .30217465E-07, .33727525E-07, .29734661E-07, .33858018E-08, 00001620 * -.14518064E-07, .13119168E-07, -.39196710E-08, -.23220796E-07, 00001630 * -.65017167E-08, 0. , .57428134E-08, .32444798E-07, 00001640 * -.33033670E-07, .47727210E-07, .29852574E-09, -.38362838E-07, 00001650 * .15172932E-08, .63973633E-08, -.51470049E-07, -.46601741E-08/ 00001660 DATA XK3/ 00001670 * -.95653368E-08, .43773022E-08, -.23353886E-08, -.39016898E-07, 00001680 * -.24557064E-07, .94553625E-09, 0. , -.94669717E-08, 00001690 * .35342428E-07, .32991333E-08, .62948016E-07, .86418052E-08, 00001700 * -.24805807E-07, -.25092104E-07, -.34787869E-07, -.51873290E-07, 00001710 * .25886898E-07, -.17196999E-07, .19435160E-07, .27397728E-07, 00001720 * .11666790E-07, .18283958E-07, -.24084318E-08, -.20617195E-07, 00001730 * 0. , .24246587E-08, .16729178E-07, -.35104404E-08, 00001740 * .91287761E-08, -.11829332E-07, -.21995350E-07, -.13643267E-07, 00001750 * .25240671E-07, .35601689E-07, -.41083644E-08, .74166530E-08, 00001760 * -.22995899E-07, -.40183925E-07, -.10234059E-07, -.19435109E-07, 00001770 * .16059728E-07, .29931349E-08, -.41603401E-07, 0. , 00001780 * -.11528521E-07, -.33953502E-07, -.19290104E-07, -.60441905E-07, 00001790 * -.21356127E-07, .62509918E-07, -.17830558E-08, -.18588764E-07, 00001800 * -.10406103E-07, -.16942653E-07, .18315359E-07, -.64119392E-08, 00001810 * -.16326759E-07, -.15947331E-07, -.30539363E-07, -.22279298E-08, 00001820 * -.34575886E-07, .18000633E-07, -.19947733E-07, 0. , 00001830 * -.36025158E-07, .58655418E-07, -.25586918E-09, -.45663980E-07, 00001840 * .22371787E-07, -.13987234E-07, -.14172726E-07, .57252713E-07/ 00001850 DATA XK4/ 00001860 * -.12331644E-07, -.16538087E-07, -.47407832E-09, .95681065E-08, 00001870 * .20558104E-08, -.29568983E-08, -.11736652E-07, .54060970E-08, 00001880 * .31005946E-07, -.22126244E-07, .70420507E-08, -.14210873E-07, 00001890 * 0. , .21759368E-07, .15267562E-07, .75878399E-08, 00001900 * .39252087E-07, -.78803434E-08, -.14540349E-07, .21671970E-07, 00001910 * -.26765232E-07, .27485651E-07, -.22095624E-07, -.30874092E-07, 00001920 * .28641239E-07, .15872843E-07, .11330852E-07, .13788365E-07, 00001930 * -.12503956E-07, -.92348043E-09, .22610405E-08, .17382678E-07, 00001940 * .15813352E-07, -.24042434E-07, 0. , .96343115E-08, 00001950 * .88316082E-08, -.53846357E-08, .59165618E-08, -.36822192E-08, 00001960 * .46772679E-08, .20180249E-07, -.14238607E-07, .17677990E-07, 00001970 * .43052142E-07, -.84238973E-08, -.14582754E-07, .12043070E-07, 00001980 * .12680452E-07, .21881167E-07, -.99092145E-08, -.51111707E-07, 00001990 * .10703423E-07, -.58699744E-10, .80738328E-08, .38958453E-07, 00002000 * -.54510580E-08, 0. , .18596723E-07, -.28178362E-07, 00002010 * -.71938387E-08, -.17928291E-07, -.29828092E-08, .12402448E-07, 00002020 * -.15115866E-07, .18246290E-07, -.11802515E-07, .11337595E-07, 00002030 * .10013530E-07, -.99441141E-08, .22411588E-08, -.46792641E-08/ 00002040 DATA XK5/ 00002050 * -.45068622E-08, -.56646867E-08, .68140306E-08, -.69450390E-08, 00002060 * .80266350E-08, -.53669015E-08, -.36176083E-07, .29615002E-07, 00002070 * -.22928783E-07, 0. , -.13173263E-07, .14899817E-07, 00002080 * -.16305971E-08, .25603935E-07, -.86420192E-08, .26063008E-07, 00002090 * .29374253E-07, -.21625637E-07, -.82423025E-08, -.44410963E-09, 00002100 * -.12477213E-08, -.30139123E-07, -.12043924E-08, -.28059821E-08, 00002110 * .12917370E-08, .16056309E-07, -.31007205E-08, .13017336E-07, 00002120 * -.16568421E-07, .29017427E-08, .50147744E-07, -.20265352E-07, 00002130 * .17152658E-08, .12550751E-08, 0. , -.31994500E-08, 00002140 * .16897553E-07, -.37176339E-08, -.50929041E-08, -.35344620E-08, 00002150 * -.10571402E-07, -.52676423E-08, -.67431696E-08, -.54180635E-08, 00002160 * -.16904437E-07, .18860471E-07, .11171601E-07, .15697912E-07, 00002170 * .67208244E-08, -.76454136E-08, -.24951916E-07, .52551626E-08, 00002180 * .65100982E-09, .20153641E-07, -.14165628E-07, -.36687585E-07, 00002190 * -.88058878E-09, -.14554909E-07, .74438713E-08, .19293753E-07/ 00002200 C...PARAMETERS OF THE NORMAL REFERENCE FIELD A=6378139. F=0.33528203723803E-02 EE=0.669439934033112E-02 XJ2=0.1082645E-02 XJJ4=-2.3710042E-06 RMEAN = 6371000. GGG=979800. 00002232 SCRD=3.24E05/ARSIN(1.0) 0000223 IF(KKK.NE.1) GO TO 10 00002240 KKK = 2 00002241 C...COMPUTATION OF THE FIRST THREE NORMALIZED EVEN ZONAL HARMONIC 00002250 C...COEFFICIENTS OF THE NORMAL GRAVITATIONAL FIELD (UP TO N = 6). 00002260 XJN2 = -XJ2/SQRT(5.) 00002270 XJN4=-XJJ4/3.0 C...SUBTRACTION OF THE NORMAL POTENTIAL FROM THE GEOPOTENTIAL IN ORDER 00002300 C... TO OBTAIN THE DISTURBING POTENTIAL. 00002310 XJ(1) = XJ(1) - XJN2 00002320 XJ(8) = XJ(8) - XJN4 00002330 C...XIGC IS THE GEOCENTRIC MERIDIAN DEVIATION. 00002350 C...ETAGC IS THE GEOCENTRIC PRIME VERTICAL DEVIATION. 00002360 C...UNDGC IS THE GEOCENTRIC GEOID UNDULATION. 00002370 C...XIGC, ETAGC AND UNDGC ARE EVALUATED USING GEM8(25,25). 00002380 10 IF(IDG.EQ.1)GOTO 120 00002390 DO 100 K=1,NRP 00002391 XLAT=XLT(K) 00002392 XLONG=XLN(K) 00002393 C...CALCULATE GEOCENTRIC LATITUDE - XLATG 00002400 XLATG = ATAN ((1. - EE)*TAN(XLAT)) 00002410 SINLTG = SIN(XLATG) 00002420 COSLTG = COS(XLATG) 00002430 CALL SPHFCT (NDO,SINLTG,COSLTG,P,PS) 00002440 C...CALCULATE DSIN(XLATG)/D(XLAT) 00002450 COSLAT = COS(XLAT) 00002460 SINLAT = SIN(XLAT) 00002470 DXLATG = (1.-EE)*COSLTG/(COSLAT*COSLAT+(1.-EE)*(1.-EE)*SINLAT*SINL00002480 *AT) 00002490 XISOM=0.0 00002500 ETASOM=0.0 00002501 UNDSOM=0.0 00002502 IJK=0 00002503 NNN=NDO+1 00002504 DO 50 N=3,NNN 00002505 NA = N - 2 00002510 DO 50 MA = 1,N 00002520 M = MA - 1 00002530 IJK = IJK + 1 00002540 XLONGM = XLONG*M 00002550 NM = N - MA 00002560 IF (NM) 20,25,20 00002570 20 DP = P(MA,N) 00002580 GO TO 30 00002590 25 DP = PS(N) 00002600 30 COSM = COS(XLONGM) 00002610 SINM = SIN(XLONGM) 00002620 XISOM = XISOM + (XJ(IJK)*COSM+XK(IJK)*SINM)*DP*DXLATG 00002630 ETASOM = ETASOM + (-XJ(IJK)*M*SINM+XK(IJK)*M*COSM)*P(N,MA) 00002640 50 UNDSOM = UNDSOM + (XJ(IJK)*COSM+XK(IJK)*SINM)*P(N,MA) 00002650 XIGC(K) = -XISOM*SCRD 00002660 ETAGC(K) = -ETASOM*SCRD/COSLAT 00002661 100 UNDGC(K) = UNDSOM*RMEAN 00002670 IF(IDG.GT.1) GO TO 200 00002671 120 DO 150 K=1,NRP 00002680 XLAT=XLT(K) 00002681 XLONG=XLN(K) 00002682 XLATG=ATAN((1.-EE)*TAN(XLAT)) 00002690 SINLTG=SIN(XLATG) 00002691 COSLTG=COS(XLATG) 00002692 CALL SPHFCT (NDO,SINLTG,COSLTG,P,PS) 00002700 C...CALCULATE THE GRAVITY ANOMALIES DG. 00002710 DGSOM=0.0 00002720 IJK=0 00002721 NNN=NDO+1 00002722 DO 140 N=3,NNN 00002723 NB=N-2 00002724 DO 140 MA=1,N 00002730 M=MA-1 00002731 IJK=IJK+1 00002732 XLONGM=XLONG*M 00002733 COSM = COS(XLONGM) 00002740 SINM = SIN(XLONGM) 00002741 140 DGSOM = DGSOM+NB*(XJ(IJK)*COSM+XK(IJK)*SINM)*P(N,MA) 00002750 150 DG(K) = GGG*DGSOM 00002760 200 RETURN 00002770 END 00002771 SUBROUTINE SPHFCT (N,SINLTG,COSLTG,P,PS) 00002780 C...THIS SUBROUTINE WAS PREPARED BY GERARD LACHAPELLE, 00002790 C...TECHNISCHE HOCHSCHULE IN GRAZ, JUNE-JULY 1974 00002800 C...THIS SUBROUTINE CALCULATE THE ASSOCIATED LEGENDRE FUNCTIONS AND THEI00002810 C...FIRST DERIVATIVES UP TO AND INCLUDING DEGREE AND ORDER N TO BE SPE00002820 C...CIFIED. THE DIMENSION OF P AND PS ARE P(N+1,N+1) AND PS(N+1)00002830 C...SINLTG AND COSLTG ARE THE SINUS AND COSINUS OF THE GEOCENTRIC LATITU00002840 C...THE ASSOCIATED LEGENDRE FUNCTIONS ARE STORED IN THE LOWER TRIANGULAR00002850 C...PART OF THE MATRIX P. THE FIRST DERIVATIVES OF THE ASSOCIATED LEGE00002860 C...FUNCTIONS ARE STORED IN THE UPPER TRIANGULAR PART OF P (ZONAL AND 00002870 C...TESSERAL) AND IN THE VECTOR PS (SECTORIAL). 00002880 C... THE ASSOCIATED LEGENDRE FUNCTION OF DEGREE A AND ORDER B IS00002890 C...THEN STORED IN P(A+1,B+1). ITS FIRST DERIVATIVE IS STORED IN P(B+00002900 C...IF A IS DIFFERENT FROM B AND IN PS(A+1) IF A=B. 00002910 DIMENSION P(26,26),PS(26) 00002920 N1 = N + 1 00002930 P(1,1) = 1.0 00002940 P(1,2) = COSLTG*1.732050808 00002950 P(2,1) = SINLTG*1.732050808 00002960 P(2,2) = P(1,2) 00002970 PS(1) = 0.0 00002980 PS(2) = -P(2,1) 00002990 C...COMPUTATION OF SECTORIAL FUNCTIONS (N=M) AND THEIR FIRST DERIVATIVES00003000 P2 = 2. 00003010 COSP = COSLTG 00003020 COSP1 = 1. 00003030 DO 50 I = 3,N1 00003040 N2 = I - 1 00003050 P2 = P2*2. 00003060 COSP = COSP*COSLTG 00003070 T = (4.*N2+2.)*FACT(2*N2,N2-1)/FACT(N2-1,0) 00003080 P(I,I) = SQRT(T/(N2*N2))*COSP/P2 00003090 PS(I) = -SQRT(T)*COSP1*SINLTG/P2 00003100 50 COSP1 = COSP1*COSLTG 00003110 C...COMPUTATION OF ZONAL AND TESSERAL FUNCTIONS 00003120 DO 70 I = 3,N1 00003130 N2 = I - 1 00003140 DO 70 J = 1,N2 00003150 M = J - 1 00003160 70 P(I,J) = SQRT((2.*N2-1.)*(2*N2+1.)/((N2-M)*(N2+M)))*SINLTG*P(I-1,J00003170 *)-SQRT((2.*N2+1.)*(N2+M-1.)*(N2-M-1)/((2.*N2-3)*(N2-M)*(N2+M)))*P(00003180 *I-2,J) 00003190 C...COMPUTATION OF THE FIRST DERIVATIVES OF THE ZONAL AND TESSERAL FUNCT00003200 DO 90 I = 3,N1 00003210 N2 = I - 1 00003220 DO 90 J = 1,N2 00003230 M = J - 1 00003240 90 P(J,I) = (SQRT((N2-M)*(2.*N2+1.)/((N2+M)*(2.*N2-1.)))*(N2+M)*P(I-00003250 *1,J) - N2*SINLTG*P(I,J))/(COSLTG*COSLTG) 00003260 RETURN 00003270 END 00003280 FUNCTION FACT(N,M) 00003290 C...CALCULATE FACT N/FACT M 00003300 C...RESTRICTION - N MUST BE GREATER OR EQUAL TO M 00003310 IF ((N.EQ.0).OR.(N.EQ.1).OR.(N.EQ.M)) GO TO 20 00003320 FACT = N 00003330 N1 = N 00003340 K = N - M - 1 00003350 DO 10 I = 1,K 00003360 N1 = N1-1 00003370 10 FACT = FACT*N1 00003380 RETURN 00003390 20 FACT = 1. 00003400 RETURN 00003410 END 00003420