initialize_globals Subroutine

private subroutine initialize_globals(me, et0, dt, etf)

initialize the earth and sun ephemeris.

Type Bound

jpl_ephemeris_splined

Arguments

Type IntentOptional Attributes Name
class(jpl_ephemeris_splined), intent(inout) :: me
real(kind=wp), intent(in) :: et0

initial ephemeris time [sec]

real(kind=wp), intent(in) :: dt

ephemeris time step [sec]

real(kind=wp), intent(in) :: etf

final ephemeris time [sec]


Calls

proc~~initialize_globals~~CallsGraph proc~initialize_globals jpl_ephemeris_splined%initialize_globals db1ink db1ink proc~initialize_globals->db1ink get_rv get_rv proc~initialize_globals->get_rv proc~destroy_body_eph_interface body_eph_interface%destroy_body_eph_interface proc~initialize_globals->proc~destroy_body_eph_interface

Called by

proc~~initialize_globals~~CalledByGraph proc~initialize_globals jpl_ephemeris_splined%initialize_globals proc~initialize_splinded_ephemeris jpl_ephemeris_splined%initialize_splinded_ephemeris proc~initialize_splinded_ephemeris->proc~initialize_globals

Source Code

    subroutine initialize_globals(me, et0, dt, etf)

        !! initialize the earth and sun ephemeris.

        class(jpl_ephemeris_splined),intent(inout) :: me
        real(wp),intent(in) :: et0 !! initial ephemeris time [sec]
        real(wp),intent(in) :: dt  !! ephemeris time step [sec]
        real(wp),intent(in) :: etf !! final ephemeris time [sec]

        integer :: i !! counter
        real(wp) :: et !! ephemeris time
        integer :: nx !! number of points
        real(wp),dimension(6) :: rv_earth, rv_sun
        logical :: status_ok
        real(wp),dimension(:),allocatable :: et_vec
        integer :: iflag

        ! write(*,*) 'initialize_globals...'
        ! write(*,*) '  et0 = ', et0
        ! write(*,*) '  dt  = ', dt
        ! write(*,*) '  etf = ', etf

        call me%earth_eph_interface%destroy()
        call me%sun_eph_interface%destroy()
        call me%ssb_eph_interface%destroy()

        if (allocated(earth_eph%tx)) deallocate(earth_eph%tx)
        if (allocated(sun_eph%tx)) deallocate(sun_eph%tx)
        if (allocated(ssb_eph%tx)) deallocate(ssb_eph%tx)
        if (allocated(earth_eph%bcoef)) deallocate(earth_eph%bcoef)
        if (allocated(sun_eph%bcoef)) deallocate(sun_eph%bcoef)
        if (allocated(ssb_eph%bcoef)) deallocate(ssb_eph%bcoef)
        if (allocated(earth_eph%f)) deallocate(earth_eph%f)
        if (allocated(sun_eph%f)) deallocate(sun_eph%f)
        if (allocated(ssb_eph%f)) deallocate(ssb_eph%f)
        if (allocated(et_vec)) deallocate(et_vec)

        ! first, count the number of points and allocate the arrays:
        nx = 0
        et = et0
        do
            if (et>etf) exit
            nx = nx + 1
            et = et + dt
        end do
        allocate(earth_eph%tx(   nx+kx,6))  ! columns are for each state element (rx,ry,rz,vx,vy,vz)
        allocate(sun_eph%tx(     nx+kx,6))
        allocate(ssb_eph%tx(     nx+kx,6))
        allocate(earth_eph%bcoef(nx,6))
        allocate(sun_eph%bcoef(  nx,6))
        allocate(ssb_eph%bcoef(  nx,6))
        allocate(earth_eph%f(    nx,6))
        allocate(sun_eph%f(      nx,6))
        allocate(ssb_eph%f(      nx,6))
        allocate(et_vec(         nx))

        ! function calls from et0 to etf:
        i = 0 ! index in the arrays
        et = et0
        do
            if (et>etf) exit
            i = i + 1
            et = et + dt
            et_vec(i) = et
            ! get_rv_from_jpl_ephemeris(me,et,targ,obs,rv,status_ok)
            call me%jpl_ephemeris%get_rv(et,body_earth,body_moon,earth_eph%f(i,:),status_ok)
            if (.not. status_ok) error stop 'earth eph error'
            call me%jpl_ephemeris%get_rv(et,body_sun,body_moon,sun_eph%f(i,:),status_ok)
            if (.not. status_ok) error stop 'sun eph error'
            call me%jpl_ephemeris%get_rv(et,body_sun,body_moon,ssb_eph%f(i,:),status_ok)
            if (.not. status_ok) error stop 'ssb eph error'
        end do

        ! create the splines (one for each coordinate):
        do i = 1, 6
            call db1ink(et_vec, nx, earth_eph%f(:,i), kx, iknot, earth_eph%tx(:,i), earth_eph%bcoef(:,i), iflag)
            if (iflag/=0) then
                write(*,*) 'db1ink iflag = ', iflag
                error stop 'db1ink error'
            end if
            call db1ink(et_vec, nx, sun_eph%f(:,i), kx, iknot, sun_eph%tx(:,i), sun_eph%bcoef(:,i), iflag)
            if (iflag/=0) then
                write(*,*) 'db1ink iflag = ', iflag
                error stop 'db1ink error'
            end if
            call db1ink(et_vec, nx, ssb_eph%f(:,i), kx, iknot, ssb_eph%tx(:,i), ssb_eph%bcoef(:,i), iflag)
            if (iflag/=0) then
                write(*,*) 'db1ink iflag = ', iflag
                error stop 'db1ink error'
            end if
        end do
        deallocate(earth_eph%f) ! don't need these anymore
        deallocate(sun_eph%f)
        deallocate(ssb_eph%f)

        earth_eph%nx = nx
        sun_eph%nx = nx
        ssb_eph%nx = nx

    end subroutine initialize_globals