inigeo1.f
9.14 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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
subroutine inigeo1 (iyear,imonth,iday,ihour,imin,isec,year,
> djulc,alfag,tetdip,phidip,alfas,deltas,
> obliq,rig,rgi,rgdip,rdipg,rgsm,rsmg,tilt,
> rggsm,rgsmg,rsmgsm,rgsmsm,rgse,rseg,
> rise,rsei,ier)
c*
c***********************************************************************
c*
c* "Copyright [c] CNES 98 - tous droits reserves"
c* **********************************************
c*
c*PRO MAGLIB
c*
c*VER 99.03.31 - V 1.0
c*VER 01.10.23 - V 2.0
c*VER 03.01.06 - V 2.1
c*VER 01.01.07 - V 3.0
c*VER 13.10.10 - V 4.0
c*VER 2017.02.24 - V 5.0
c*
c*AUT spec. CNES - JC KOSIK - janvier 1991
c*AUT port. CISI
c*AUT adapt. AKKA
c*
c*ROL Theme : Modules d'initialisation
c*ROL Initialisation de toutes les matrices de rotation
c*ROL necessaires aux calculs geophysiques et geomagnetiques
c*ROL pour CLUSTER, ainsi que l'angle de tilt, l'orientation
c*ROL de l'axe du dipole, l'ascension droite et la declinaison
c*ROL du soleil.
c*
c*PAR iyear (I) : annee (>= 2000)
c*PAR imonth (I) : mois
c*PAR iday (I) : jour
c*PAR ihour (I) : heures
c*PAR imin (I) : minutes
c*PAR isec (I) : secondes
C*
c*PAR year (O) : annee fractionnaire (>= 2000.)
c*
c*PAR djulc (O) : date julienne CNES fractionnaire (depuis le 01/01/1950)
c*
c*PAR alfag (O) : ascension droite de Greenwich (radians)
c*PAR tetdip (O) : colatitude geocentrique du point ou le dipole
c*PAR : coupe l'hemisphere nord (radians)
c*PAR phidip (O) : longitude geocentrique du point ou le dipole
c*PAR : coupe l'hemisphere nord (radians)
c*
c*PAR alfas (O) : ascension droite du soleil (radians)
c*PAR deltas (O) : declinaison du soleil (radians)
c*
c*PAR obliq (O) : obliquite de l'ecliptique (radians)
c*
c*PAR rig (O) : matrice (3,3) de passage du repere inertiel
c*PAR : au repere geocentrique
c*PAR rgi (O) : matrice (3,3) de passage du repere geocentrique
c*PAR : au repere inertiel
c*
c*PAR rgdip (O) : matrice (3,3) de passage du repere geographique
c*PAR : au repere dipolaire
c*PAR rdipg (O) : matrice (3,3) de passage du repere dipolaire
c*PAR : au repere geocentrique
c*
c*PAR rgsm (O) : matrice (3,3) de passage du repere geocentrique
c*PAR : au repere solaire magnetique
c*PAR rsmg (O) : matrice (3,3) de passage du repere solaire
c*PAR : magnetique au repere geocentrique
c*
c*PAR tilt (O) : angle de tilt (radians)
c*
c*PAR rggsm (O) : matrice (3,3) de passage du repere geocentrique
c*PAR : au repere solaire magnetospherique
c*PAR rgsmg (O) : matrice (3,3) de passage du repere solaire
c*PAR : magnetospherique au repere geocentrique
c*
c*PAR rsmgsm (O) : matrice (3,3) de passage du repere solaire
c*PAR : magnetique au repere solaire magnetospherique
c*PAR rgsmsm (O) : matrice (3,3) de passage du repere solaire
c*PAR : magnetospherique au repere solaire magnetique
c*
c*PAR rgse (O) : matrice (3,3) de passage du repere geocentrique
c*PAR : au repere solaire ecliptique
c*PAR rseg (O) : matrice (3,3) de passage du repere solaire
c*PAR : ecliptique au repere geocentrique
c*
c*PAR rise (O) : matrice (3,3) de passage du repere inertiel
c*PAR rsei (O) : matrice (3,3) de passage du repere solaire
c*
c*PAR ier (O) : code de retour
c*
c*NOT ier : = 1 si iyear < 2000
c*
c*INF utilise : solter00, solter05, solter10, solter15,
c*INF utilise : roig, rogdip, rogsm, roggsm, rogse, roise, rosmgs
c*
c*HST version 1.0 - 15.09.98 - creation de la maglib au CDPP
c*HST version 2.0 - 01.10.23 - ajout de soltern
c*HST version 2.1 - 03.01.06 - corrections en compilation avec g77
c*HST version 3.0 - 01.01.07 - adoption des coefficients definitifs
c*HST du champ 2000
c*HST version 4.0 - 13.10.10 - Calcule entre 2000 et 2014
c*HST version 5.0 - 2017.02.24 - Calcule entre 2000 et 2019 (ajout du
c*HST module solter15).
c*
c***********************************************************************
c*
implicit none
c
c ---------------------------------
c*FON Declaration identificateur rcs_id
c ---------------------------------
c
character rcs_id*100
c
c --------------------------
c*FON Declaration des parametres
c --------------------------
c
integer iyear, imonth, iday, ihour, imin, isec
double precision year, djulc
double precision alfag
double precision tetdip, phidip
double precision alfas, deltas
double precision obliq
double precision rig(3,3), rgi(3,3)
double precision rgdip(3,3), rdipg(3,3)
double precision rgsm(3,3), rsmg(3,3)
double precision tilt
double precision rggsm(3,3), rgsmg(3,3)
double precision rise(3,3), rsei(3,3)
double precision rgse(3,3), rseg(3,3)
double precision rsmgsm(3,3), rgsmsm(3,3)
integer ier
c
c ----------------------------------
c*FON Declaration des fonctions externes
c ----------------------------------
c
external julg
integer julg
c
c ---------------------------------
c*FON Declaration des variables locales
c ---------------------------------
c
integer ierjul
c*LOVC ierjul : erreur sur calcul de la date julienne
c
integer ier1,ier2,ier3,ier4,ier5,ier6,ier7,ier8
c*LOC ier1 a ier8 : codes retour des modules appeles
c
double precision fjour
c
SAVE
c
c ---------------------------------
c*FON Affectation identificateur rcs_id
c ---------------------------------
c
data rcs_id /"
>$Id$"/
c
c ******************
c Debut de programme
c ******************
c
ier = 0
ier1 = 0
ier2 = 0
ier3 = 0
ier4 = 0
ier5 = 0
ier6 = 0
ier7 = 0
ier8 = 0
ierjul = 0
c
c --------------------------------------
c*FON Calcul de la date julienne CNES djulc
c --------------------------------------
c
fjour = dble((ihour * 60 + imin) * 60 + isec) / 86400.d0
djulc = dble(julg (iday,imonth,iyear,ierjul)) + fjour
c
c ----------------------------------------------------------
c*FON Calcul de la position inertielle de Greenwich et du soleil
c*FON et des angles d'orientation du dipole terrestre suivant
c*FON la periode, 2000-2005 ou 2005-2010 ou 2010-2015 ou 2015-2020
c ----------------------------------------------------------
c
if (iyear .ge. 2000 .and. iyear .lt. 2005) then
c
call solter00(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> alfas,deltas,obliq,tetdip,phidip,ier1)
c
else if (iyear .ge. 2005 .and. iyear .lt. 2010) then
c
call solter05(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> alfas,deltas,obliq,tetdip,phidip,ier1)
c
else if (iyear .ge. 2010 .and. iyear .lt. 2015) then
c
call solter10(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> alfas,deltas,obliq,tetdip,phidip,ier1)
c
else if (iyear .ge. 2015) then
c
call solter15(iyear,imonth,iday,ihour,imin,isec,year,alfag,
> alfas,deltas,obliq,tetdip,phidip,ier1)
c
else
ier = 1
endif
c
c ------------------------------------------------------
c*FON Calcul des matrices de passage du repere inertiel vers
c*FON le repere geographique
c ------------------------------------------------------
c
call roig(alfag,rig,rgi,ier2)
c
c --------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique au
c*FON repere dipolaire
c --------------------------------------------------------
c
call rogdip(tetdip,phidip,rgdip,rdipg,ier3)
c
c ----------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique vers
c*FON le repere solaire-magnetique
c ----------------------------------------------------------
c
call rogsm(rgdip,alfag,alfas,deltas,rgsm,rsmg,
> tilt,ier4)
c
c ----------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique vers
c*FON le repere solaire-magnetospherique
c ----------------------------------------------------------
c
call roggsm(tilt,rgsm,rggsm,rgsmg,ier5)
c
c -----------------------------------------------------------
c*FON Calcul des matrices de passage du repere inertiel au repere
c*FON solaire magnetospherique gsm
c -----------------------------------------------------------
c
call rogse(alfag,alfas,deltas,obliq,rgse,rseg,ier6)
c
c -----------------------------------------------------------
c*FON calcul des matrices de passage du repere inertiel au repere
c*FON solaire ecliptique
c -----------------------------------------------------------
c
call roise(alfas,deltas,obliq,rise,rsei,ier7)
c
c ------------------------------------------------------------
c*FON calcul des matrices de passage du repere sm au repere gsm et
c*FON inverse
c ------------------------------------------------------------
c
call rosmgs(tilt,rsmgsm,rgsmsm,ier8)
c
c ****************
c Fin de programme
c ****************
c
return
end