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
|
!/*-----------------------------------------------------------------*/
!/*!
! \file f2003multiple.f
! \brief Example of usage of the multiple file access functions
! with a fortran compiler compliant with the fortran 2003 standard
! This example reads the constant EMRAT, AU, GM_Mer and print their values.
! It computes for a date
! the geocentric moon coordinates,
! the value TT-TDB
! the heliocentric coordinates of Mars.
!
! \author M. Gastineau
! Astronomie et Systemes Dynamiques, IMCCE, CNRS, Observatoire de Paris.
!
! Copyright, 2008-2023, CNRS
! email of the author : Mickael.Gastineau@obspm.fr
!
!*/
!/*-----------------------------------------------------------------*/
!/*-----------------------------------------------------------------*/
!/* License of this file :
! This file is "triple-licensed", you have to choose one of the three licenses
! below to apply on this file.
!
! CeCILL-C
! The CeCILL-C license is close to the GNU LGPL.
! ( http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html )
!
! or CeCILL-B
! The CeCILL-B license is close to the BSD.
! (http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt)
!
! or CeCILL v2.1
! The CeCILL license is compatible with the GNU GPL.
! ( http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.html )
!
!
! This library is governed by the CeCILL-C, CeCILL-B or the CeCILL license under
! French law and abiding by the rules of distribution of free software.
! You can use, modify and/ or redistribute the software under the terms
! of the CeCILL-C,CeCILL-B or CeCILL license as circulated by CEA, CNRS and INRIA
! at the following URL "http://www.cecill.info".
!
! As a counterpart to the access to the source code and rights to copy,
! modify and redistribute granted by the license, users are provided only
! with a limited warranty and the software's author, the holder of the
! economic rights, and the successive licensors have only limited
! liability.
!
! In this respect, the user's attention is drawn to the risks associated
! with loading, using, modifying and/or developing or reproducing the
! software by the user in light of its specific status of free software,
! that may mean that it is complicated to manipulate, and that also
! therefore means that it is reserved for developers and experienced
! professionals having in-depth computer knowledge. Users are therefore
! encouraged to load and test the software's suitability as regards their
! requirements in conditions enabling the security of their systems and/or
! data to be ensured and, more generally, to use and operate it in the
! same conditions as regards security.
!
! The fact that you are presently reading this means that you have had
! knowledge of the CeCILL-C,CeCILL-B or CeCILL license and that you accept its terms.
!*/
!/*-----------------------------------------------------------------*/
!/*-----------------------------------------------------------------*/
!/* print coordinates */
!/*-----------------------------------------------------------------*/
subroutine printcoord(PV,name)
implicit none
real(8), intent(in):: PV(6)
character(len=*), intent(in) :: name
integer j
write(*,*) name, " :"
do j=1,6
write(*,*) PV(j)
enddo
write(*,*)
end subroutine
!/*-----------------------------------------------------------------*/
!/* main program */
!/*-----------------------------------------------------------------*/
program f2003multiple
USE, INTRINSIC :: ISO_C_BINDING
use calceph
implicit none
integer res
real(8) AU, EMRAT, GM_Mer
real(8) jd0
real(8) dt
real(8) PV(6)
integer j
real(8) valueconstant
character(len=CALCEPH_MAX_CONSTANTNAME) nameconstant
TYPE(C_PTR) :: peph
integer cont, t
real(8) jdfirst, jdlast
integer earth, moon
jd0 = 2442457
dt = 0.5E0
! open the ephemeris file
peph = calceph_open("example1.dat"//C_NULL_CHAR)
if (C_ASSOCIATED(peph)) then
write (*,*) "The ephemeris is already opened"
! print the time span
t = calceph_gettimescale(peph)
if (t.eq.1) then
write (*,*) "timescale : TDB"
endif
if (t.eq.2) then
write (*,*) "timescale : TCB"
endif
if (calceph_gettimespan(peph, jdfirst, jdlast, cont).eq.1) &
& then
write(*,*) "data available between ",jdfirst,"and",jdlast
write(*,*) "continuous data : ", cont
endif
! print the values of AU, EMRAT and GM_Mer
if (calceph_getconstant(peph, "AU"//C_NULL_CHAR, &
& AU).eq.1) then
write (*,*) "AU=", AU
endif
if (calceph_getconstant(peph,"EMRAT"//C_NULL_CHAR, &
& EMRAT).eq.1) then
write (*,*) "EMRAT=", EMRAT
endif
if (calceph_getconstant(peph,"GM_Mer"//C_NULL_CHAR, &
& GM_Mer).eq.1) then
write (*,*) "GM_Mer=", GM_Mer
endif
! compute and print the coordinates
! the geocentric moon coordinates in AU and AU/day
res = calceph_getidbyname(peph, "Moon"//C_NULL_CHAR, 0, &
& moon)
res = calceph_getidbyname(peph, "Earth"//C_NULL_CHAR, 0, &
& earth)
res = calceph_compute(peph,jd0, dt, moon, earth, PV)
call printcoord(PV, &
& "geocentric coordinates of the Moon in AU and AU/day")
! the geocentric moon coordinates in km and km/s
res = calceph_compute_unit(peph,jd0, dt, moon, earth, &
& CALCEPH_UNIT_KM+CALCEPH_UNIT_SEC, PV)
call printcoord(PV, &
& "geocentric coordinates of the Moon in km and km/s")
! the value TT-TDB
if (calceph_compute(peph,jd0, dt, 16, 0, PV).eq.1) then
write (*,*) "TT-TDB = ", PV(1)
endif
! the heliocentric coordinates of Mars
res = calceph_compute(peph,jd0, dt, 4, 11, PV)
call printcoord(PV,"heliocentric coordinates of Mars")
! print the whole list of the constants
write (*,*) "list of constants"
do j=1, calceph_getconstantcount(peph)
res = calceph_getconstantindex(peph,j,nameconstant, &
& valueconstant)
write (*,*) nameconstant,"=",valueconstant
enddo
! close the ephemeris file
call calceph_close(peph)
write (*,*) "The ephemeris is already closed"
else
write (*,*) "The ephemeris can't be opened"
endif
stop
end
|
