diplat.f
61 lines
| 1.8 KiB
| text/x-fortran
|
FortranFixedLexer
| r0 | C $Id: diplat.f 3304 2011-01-17 15:25:59Z brideout $ | |||
| SUBROUTINE DIPLAT(TM,GDLAT,GLON,GDALT,AINC,DEC,RLATM) | ||||
| C .. Scalar Arguments .. | ||||
| DOUBLE PRECISION AINC,DEC,GDALT,GDLAT,GLON,RLATM,TM | ||||
| C .. | ||||
| C .. Local Scalars .. | ||||
| DOUBLE PRECISION B,BP,BR,BT,CP,CT,DTR,GCLAT,HB,P,PFX,PFY,PFZ,RFP, | ||||
| * RFR,RFT,RFX,RFY,RFZ,RKM,RP,RR,RT,SP,ST,T,XB,YB,ZB | ||||
| C .. | ||||
| C .. External Subroutines .. | ||||
| EXTERNAL CONVRT,GDV,MILMAG,VCTCNV | ||||
| C .. | ||||
| C .. Intrinsic Functions .. | ||||
| INTRINSIC ATAN,ATAN2,COS,SIN,SQRT,TAN | ||||
| C .. | ||||
| C .. Data statements .. | ||||
| C | ||||
| C DIPLAT CALCULATES THE INCLINATION, DECLINATION AND DIP LATITUDE | ||||
| C OF A POINT SPECIFIED BY ITS GEODETIC LATITUDE, LONGITUDE AND | ||||
| C ALTITUDE. | ||||
| C | ||||
| C INPUT | ||||
| C TM - TIME IN YEARS (E.G. 1975.2) | ||||
| C GDLAT - GEODETIC LATITUDE OF OBSERVATION POINT | ||||
| C GLON - LONGITUDE OF OBSERVATION POINT | ||||
| C GDALT - ALTITUDE ABOVE SPHEROID OF OBSERVATION POINT | ||||
| C OUTPUT | ||||
| C AINC - INCLINATION OF FIELD | ||||
| C DEC - DECLINATION OF FIELD | ||||
| C RLATM - DIP LATITUDE | ||||
| C | ||||
| DATA DTR/.0174532925199D0/ | ||||
| C .. | ||||
| C | ||||
| C .....FIND GEOCENTRIC COORDINATES OF POINT..... | ||||
| CALL CONVRT(1,GDLAT,GDALT,GCLAT,RKM) | ||||
| C | ||||
| C .....CALCULATE MAGNETIC FIELD AT OBSERVATION POINT..... | ||||
| T = DTR*(90.D0-GCLAT) | ||||
| CT = COS(T) | ||||
| ST = SIN(T) | ||||
| P = DTR*GLON | ||||
| CP = COS(P) | ||||
| SP = SIN(P) | ||||
| CALL MILMAG(TM,RKM,ST,CT,SP,CP,BR,BT,BP,B) | ||||
| CALL GDV(GDLAT,GCLAT,BR,BT,BP,XB,YB,ZB) | ||||
| C | ||||
| C .....CALCULATE INCLINATION..... | ||||
| HB = SQRT(XB*XB+YB*YB) | ||||
| AINC = ATAN2(ZB,HB)/DTR | ||||
| C | ||||
| C .....CALCULATE DECLINATION..... | ||||
| DEC = ATAN2(YB,XB)/DTR | ||||
| C | ||||
| C .....CALCULATE DIP LATITUDE..... | ||||
| RLATM = ATAN(.5D0*TAN(DTR*AINC))/DTR | ||||
| CALL VCTCNV(RFX,RFY,RFZ,PFX,PFY,PFZ,RFR,RFT,RFP,RR,RT,RP,1) | ||||
| RETURN | ||||
| C | ||||
| END | ||||
