get_scales_from_segs Subroutine

public subroutine get_scales_from_segs(me)

Populate the xscale and fscale problem arrays from the segment data.

Type Bound

mission_type

Arguments

Type IntentOptional Attributes Name
class(mission_type), intent(inout) :: me

Calls

proc~~get_scales_from_segs~~CallsGraph proc~get_scales_from_segs mission_type%get_scales_from_segs fill_vector fill_vector proc~get_scales_from_segs->fill_vector proc~define_problem_size mission_type%define_problem_size proc~get_scales_from_segs->proc~define_problem_size

Called by

proc~~get_scales_from_segs~~CalledByGraph proc~get_scales_from_segs mission_type%get_scales_from_segs proc~initialize_the_mission mission_type%initialize_the_mission proc~initialize_the_mission->proc~get_scales_from_segs proc~initialize_the_solver my_solver_type%initialize_the_solver proc~initialize_the_solver->proc~initialize_the_mission proc~halo_solver_main halo_solver_main proc~halo_solver_main->proc~initialize_the_solver

Source Code

    subroutine get_scales_from_segs(me)

    implicit none

    class(mission_type),intent(inout) :: me

    integer :: i,j,ii !! counter
    integer :: iseg   !! segment number counter
    integer :: n_segs !! number of segments
    character(len=10) :: iseg_str  !! segment number string

    character(len=*),parameter :: t0_label = 'T0 (day)'
    character(len=9),dimension(6),parameter :: x0_label = ['Rx (km)  ',&
                                                           'Ry (km)  ',&
                                                           'Rz (km)  ',&
                                                           'Vx (km/s)',&
                                                           'Vy (km/s)',&
                                                           'Vz (km/s)']

    ! iseg loop: x: [1,2,4,...n_segs]
    !            f: [  2,4,...n_segs]

    call me%define_problem_size(n_segs=n_segs)

    i = 0 ! for xscale
    ii = 0 ! for dpert
    j = 0 ! for xname
    ! x scales - segment 1:
    if (.not. me%fix_initial_time) then
        call fill_vector(me%xscale, me%segs(1)%data%t0_scale, i)
        call fill_vector(me%dpert_, me%segs(1)%data%t0_dpert, ii)
        call fill_vector(me%xname, 'SEG1 '//t0_label, j)
    end if
    if (me%fix_initial_r) then
        call fill_vector(me%xscale, me%segs(1)%data%x0_rotating_scale(4:6), i)
        call fill_vector(me%dpert_, me%segs(1)%data%x0_rotating_dpert(4:6), ii)
        call fill_vector(me%xname, 'SEG1 '//x0_label(4:6), j)
    else
        call fill_vector(me%xscale, me%segs(1)%data%x0_rotating_scale, i)
        call fill_vector(me%dpert_, me%segs(1)%data%x0_rotating_dpert, ii)
        call fill_vector(me%xname, 'SEG1 '//x0_label, j)
    end if
    ! x scales - the rest:
    do iseg = 2, n_segs, 2
        write(iseg_str,'(I10)') iseg
        call fill_vector(me%xscale, me%segs(iseg)%data%t0_scale, i)
        call fill_vector(me%dpert_, me%segs(iseg)%data%t0_dpert, ii)
        call fill_vector(me%xname, 'SEG'//trim(adjustl(iseg_str))//' '//t0_label, j)
        if (iseg == me%fix_ry_at_end_of_rev*8) then
            call fill_vector(me%xscale, me%segs(iseg)%data%x0_rotating_scale([1,3,4,5,6]), i)
            call fill_vector(me%dpert_, me%segs(iseg)%data%x0_rotating_dpert([1,3,4,5,6]), ii)
            call fill_vector(me%xname, 'SEG'//trim(adjustl(iseg_str))//' '//x0_label([1,3,4,5,6]), j)
            cycle
        else if (me%fix_final_ry_and_vx .and. iseg == n_segs) then ! last state point
            call fill_vector(me%xscale, me%segs(iseg)%data%x0_rotating_scale([1,3,5,6]), i)
            call fill_vector(me%dpert_, me%segs(iseg)%data%x0_rotating_dpert([1,3,5,6]), ii)
            call fill_vector(me%xname, 'SEG'//trim(adjustl(iseg_str))//' '//x0_label([1,3,5,6]), j)
            cycle
        else
            ! otherwise, full state:
            call fill_vector(me%xscale, me%segs(iseg)%data%x0_rotating_scale, i)
            call fill_vector(me%dpert_, me%segs(iseg)%data%x0_rotating_dpert, ii)
            call fill_vector(me%xname, 'SEG'//trim(adjustl(iseg_str))//' '//x0_label, j)
        end if
    end do

    ! f scales:
    i = 0 ! reset for f
    do iseg = 2, n_segs, 2
        call fill_vector(me%fscale, me%segs(iseg)%data%xf_rotating_scale, i)
    end do

    ! write(*,*) ''
    ! write(*,*) 'xscale: ', me%xscale
    ! write(*,*) ''
    ! write(*,*) 'fscale: ', me%fscale
    ! write(*,*) ''

    end subroutine get_scales_from_segs