getmag.f
4.59 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
subroutine getmag (iyear,imonth,iday,ihour,imin,isec,
> magout, isatex, rrmag, thetr, phir,
> tgl, flg, xlamb, ifail)
c*FON Declaration des parametres
c --------------------------
c
c***********************************************************************
c* *
c* DECLARATIONS *
c* *
c***********************************************************************
c*
implicit none
c
c --------------------------------
c*FON rcs_id identificator declaration
c --------------------------------
c
character rcs_id*100
c
c ---------------------------
c*FON parameters declaration
c ---------------------------
integer iyear,imonth,iday,ihour,imin,isec
integer isatex, magout
double precision rrmag, thetr, phir
double precision tgl, flg, xlamb
integer ifail
c ----------------------------
c*FON Common variables declaration
c ----------------------------
c
double precision pi,dpi,rad,deg,pid,xmu,rayt
c
c*COM pi : constant pi (equal to cos(-1.))
c*COM dpi : constant 2 * pi
c*COM pid : constant pi / 2
c*COM rad : conversion value degrees ----> radians
c*COM deg : conversion value radians ----> degrees
c*COM xmu : earth gravity constant (km**3/sec**2)
c*COM rayt : equatorial earth radius (km)
c
common/util/pi,dpi,rad,deg,pid,xmu,rayt
c
c ---------------------------
c*FON Local variables declaration
c ---------------------------
c
integer iposmg(15)
integer ii
c
double precision rig(3,3),rgi(3,3),rgsm(3,3),rsmg(3,3)
double precision rggsm(3,3),rgsmg(3,3),rgse(3,3),rseg(3,3)
double precision rgdip(3,3),rdipg(3,3),rigsm(3,3)
double precision rgsmi(3,3)
double precision alfag,alfas,deltas,tilt
double precision tetdip,phidip,xgsm,ygsm,zgsm,xgse,ygse,zgse
double precision tglc,hsl,clatgmr,clongmr
double precision clatgm,clongm
double precision year
c
SAVE rig,rgi,rgsm,rsmg
SAVE rggsm,rgsmg,rgse,rseg
SAVE rgdip,rdipg,rigsm
SAVE rgsmi
SAVE alfag,alfas,deltas,tilt
SAVE tetdip,phidip,xgsm,ygsm,zgsm,xgse,ygse,zgse
SAVE tglc,hsl,clatgmr,clongmr
SAVE year
c
c ----------------------------
c*FON Setting rcs_id identificator
c ----------------------------
c
data rcs_id /"
>$id$"/
c
c***********************************************************************
c* *
c* BEGINING OF THE PROGRAM *
c* *
c***********************************************************************
c -------------------------
c*FON Constants initializations
c -------------------------
c
call valfix(ifail)
c
c ----------------------------
c*FON Entering the test parameters
c ----------------------------
c
c --------------------------------------------------
c*FON Initialization of all the rotation matrices used
c*FON by the geomagnetic calculations for the given year
c --------------------------------------------------
c
if (iyear .ge. 2000) then
call inigeom(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> tetdip,phidip,alfas,deltas,rig,rgi,rgdip,rdipg,
> rgsm,rsmg,tilt,rggsm,rgsmg,rgse,rseg,rigsm,rgsmi,
> ifail)
call posmag(magout,isatex,year,rrmag,thetr,phir,alfag,
> alfas,deltas,tilt,rgsm,rggsm,rgsmg,rgdip,rgse,
> tetdip,phidip,xgsm,ygsm,zgsm,xgse,ygse,zgse,tgl,
> flg,xlamb,tglc,hsl,clatgmr,clongmr,iposmg,ifail)
else
call inigeomv(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> tetdip,phidip,alfas,deltas,rig,rgi,rgdip,rdipg,
> rgsm,rsmg,tilt,rggsm,rgsmg,rgse,rseg,rigsm,rgsmi,
> ifail)
call posmagv(magout,isatex,year,rrmag,thetr,phir,alfag,
> alfas,deltas,tilt,rgsm,rggsm,rgsmg,rgdip,rgse,
> tetdip,phidip,xgsm,ygsm,zgsm,xgse,ygse,zgse,tgl,
> flg,xlamb,tglc,hsl,clatgmr,clongmr,iposmg,ifail)
endif
c -------------------------------------------------------------
c*FON Calculation of the position of the point in the magnetosphere
c -------------------------------------------------------------
c
c return
end