export_rp_ra_json_file Subroutine

public subroutine export_rp_ra_json_file(me, et, rmag, rdot, filename)

Uses

  • proc~~export_rp_ra_json_file~~UsesGraph proc~export_rp_ra_json_file mission_type%export_rp_ra_json_file bspline_module bspline_module proc~export_rp_ra_json_file->bspline_module root_module root_module proc~export_rp_ra_json_file->root_module

Export the rp/ra file.

Note

It is assumed that all the data is present in the segments needed to propagate.

Type Bound

mission_type

Arguments

Type IntentOptional Attributes Name
class(mission_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(:) :: et
real(kind=wp), intent(in), dimension(:) :: rmag
real(kind=wp), intent(in), dimension(:) :: rdot
character(len=*), intent(in) :: filename

file name [without extension]


Calls

proc~~export_rp_ra_json_file~~CallsGraph proc~export_rp_ra_json_file mission_type%export_rp_ra_json_file add add proc~export_rp_ra_json_file->add destroy destroy proc~export_rp_ra_json_file->destroy evaluate evaluate proc~export_rp_ra_json_file->evaluate initialize initialize proc~export_rp_ra_json_file->initialize solve solve proc~export_rp_ra_json_file->solve

Called by

proc~~export_rp_ra_json_file~~CalledByGraph proc~export_rp_ra_json_file mission_type%export_rp_ra_json_file proc~export_trajectory_json_file mission_type%export_trajectory_json_file proc~export_trajectory_json_file->proc~export_rp_ra_json_file proc~halo_solver_main halo_solver_main proc~halo_solver_main->proc~export_trajectory_json_file

Source Code

    subroutine export_rp_ra_json_file(me,et,rmag,rdot,filename)

    use root_module
    use bspline_module

    class(mission_type),intent(inout) :: me
    real(wp),dimension(:),intent(in) :: et
    real(wp),dimension(:),intent(in) :: rmag
    real(wp),dimension(:),intent(in) :: rdot
    character(len=*),intent(in) :: filename !! file name [without extension]

    type,extends(chandrupatla_solver) :: my_solver
        !! the solver to use for the root finding
    end type my_solver

    real(wp) :: et0, etf, et_root, rdot_root, initial_et, final_et, rdot0, rdotf, rmag_root
    integer :: i, n
    real(wp),dimension(:),allocatable :: et_for_rp, et_for_ra, rp_vec, ra_vec
    real(wp) :: x, f
    integer :: iflag
    type(my_solver) :: solver
    type(bspline_1d) :: rdot_spline, rmag_spline
    type(json_file) :: json
    logical :: finished !! to indicate the arrays are done
    integer :: n_rp, n_ra, n_rp_et, n_ra_et !! counters for array sizes

    integer,parameter :: kx = 4  !! spline order (cubic bspline)
    integer,parameter :: idx = 0 !! interpolate value only
    real(wp),parameter :: et_step = 3600.0_wp * 24.0_wp !! et step size [should be an input] (sec)
    integer,parameter :: chunk_size = 1000 !! chunk size for expanding the arrays

    write(*,'(A)') ' * Generating ra/rp file.'

    ! error check to make sure et is strictly increasing.
    do i = 2, size(et)
        if (et(i)<=et(i-1)) then
            write(*,*) 'error in et point ', i
            write(*,*) 'et(i)  ', et(i)
            write(*,*) 'et(i-1)', et(i-1)
            error stop
        end if
    end do
    ! first spline rmag and rdot as a functions of et:
    call rdot_spline%initialize(et,rdot,kx,iflag,.false.); call check_spline('rdot')
    call rmag_spline%initialize(et,rmag,kx,iflag,.false.); call check_spline('rmag')

    allocate(et_for_rp(0), et_for_ra(0), rp_vec(0), ra_vec(0)) ! arrays to hold results

    ! step through the trajectory and find all the rdot roots (periapsis and apoapsis):
    call solver%initialize(rdot_func)
    n = size(et)
    initial_et = et(1)
    final_et = et(n)
    et0 = initial_et
    n_rp = 0; n_ra = 0; n_rp_et = 0; n_ra_et = 0
    do
        etf = min(final_et, et0+et_step)
        ! if there is a root on this interval (change of sign of rdot):
        rdot0 = rdot_func(solver, et0)
        rdotf = rdot_func(solver, etf)
        finished = etf==et(n) ! the last step
        if (rdot0*rdotf<=zero) then  ! there is a root on this interval
            ! find the root:
            call solver%solve(et0,etf,et_root,rdot_root,iflag)
            rmag_root = rmag_func(et_root)  ! get corresponding rmag at the root
            if (rdotf>rdot0) then
                ! increasing - periapsis
                ! et_for_rp = [et_for_rp, et_root]
                ! rp_vec    = [rp_vec, rmag_root]
                call add_to(et_for_rp, et_root, n_rp_et, chunk_size, finished)
                call add_to(rp_vec, rmag_root, n_rp, chunk_size, finished)
            else
                ! decreasing - apoapsis
                !et_for_ra = [et_for_ra, et_root]
                !ra_vec    = [ra_vec, rmag_root]
                call add_to(et_for_ra, et_root, n_ra_et, chunk_size, finished)
                call add_to(ra_vec, rmag_root, n_ra, chunk_size, finished)
            end if
        end if
        if (finished) exit
        et0 = etf ! set up for next step
    end do

    ! output results to file:
    call json%initialize(compress_vectors=.true.)
    call json%add('et_for_rp', et_for_rp)
    call json%add('rp_vec',    rp_vec)
    call json%add('et_for_ra', et_for_ra)
    call json%add('ra_vec',    ra_vec)
    call json%print(trim(filename)//'_rp_ra.json')
    call json%destroy()

    contains

        pure subroutine add_to(vec, val, n, chunk_size, finished)
            !! resize an array in chunks

            real(wp), dimension(:), allocatable, intent(inout) :: vec
                !! the vector to add to
            real(wp), intent(in) :: val
                !! the value to add
            integer, intent(inout) :: n
                !! counter for last element added to vec.
                !! must be initialized to size(vec)
                !! (or 0 if not allocated) before first call
            integer, intent(in) :: chunk_size
                !! allocate vec in blocks of this size (>0)
            logical, intent(in) :: finished
                !! set to true to return vec
                !! as its correct size (n)

            real(wp), dimension(:), allocatable :: tmp

            if (allocated(vec)) then
                if (n == size(vec)) then
                    ! have to add another chunk:
                    allocate (tmp(size(vec) + chunk_size))
                    tmp(1:size(vec)) = vec
                    call move_alloc(tmp, vec)
                end if
                n = n + 1
            else
                ! the first element:
                allocate (vec(chunk_size))
                n = 1
            end if

            vec(n) = val

            if (finished) then
                ! set vec to actual size (n):
                if (allocated(tmp)) deallocate (tmp)
                allocate (tmp(n))
                tmp = vec(1:n)
                call move_alloc(tmp, vec)
            end if

        end subroutine add_to

        subroutine check_spline(case) !! error checking for splines
            character(len=*),intent(in) :: case !! case name
            if (iflag/=0) then
                select case (iflag)
                case(2); error stop case//' : bspline error: iknot out of range.'
                case(3); error stop case//' : bspline error: nx out of range.'
                case(4); error stop case//' : bspline error: kx out of range.'
                case(5); error stop case//' : bspline error: x not strictly increasing.'
                end select
            end if
        end subroutine check_spline

        function rdot_func(me,x)  !! compute rdot from spline
            class(root_solver),intent(inout) :: me
            real(wp),intent(in) :: x
            real(wp) :: rdot_func
            integer :: iflag
            call rdot_spline%evaluate(x,idx,rdot_func,iflag)
            if (iflag/=0) error stop 'error evaluating bspline for rdot.'
        end function rdot_func
        function rmag_func(x)  !! compute rmag from spline
            real(wp),intent(in) :: x
            real(wp) :: rmag_func
            integer :: iflag
            call rmag_spline%evaluate(x,idx,rmag_func,iflag)
            if (iflag/=0) error stop 'error evaluating bspline for rmag.'
        end function rmag_func

    end subroutine export_rp_ra_json_file