! simple interface routines such that f2py does not have to also compile ! parts no needed for the interface. ! ----------------------------------------------------------------------- subroutine set_verbose_(verbose) use typedef, only: & int64 use parameters, only: & set_verbose implicit none integer(kind=int64), intent(in) :: & verbose call set_verbose(verbose) end subroutine set_verbose_ subroutine get_verbose_(verbose) use typedef, only: & int64 use parameters, only: & get_verbose implicit none integer(kind=int64), intent(out) :: & verbose verbose = get_verbose() end subroutine get_verbose_ ! ----------------------------------------------------------------------- subroutine get_status_(status, status_stars) use typedef, only: & int64 use states, only: & get_status implicit none integer(kind=int64), intent(out) :: & status integer(kind=int64), dimension(2), intent(out) :: & status_stars call get_status(status, status_stars) end subroutine get_status_ subroutine reset_status_ use states, only: & reset_status implicit none call reset_status end subroutine reset_status_ ! ----------------------------------------------------------------------- subroutine set_interact_(interact) use typedef, only: & real64 use parameters, only: & set_interact implicit none real(kind=real64), intent(in), dimension(:,:) :: & interact call set_interact(interact) end subroutine set_interact_ subroutine get_interact_size_(n) use typedef, only: & int64 use parameters, only: & get_interact_size implicit none integer(kind=int64), intent(out) :: & n call get_interact_size(n) end subroutine get_interact_size_ subroutine get_interact_(interact, n) use typedef, only: & real64, int64 use parameters, only: & get_interact implicit none real(kind=real64), intent(out), dimension(n,n) :: & interact integer(kind=int64), intent(in) :: & n call get_interact(interact) end subroutine get_interact_ subroutine reset_interact_ use parameters, only: & reset_interact implicit none call reset_interact end subroutine reset_interact_ ! ----------------------------------------------------------------------- subroutine set_cutoff_(cutoff) use typedef, only: & real64 use parameters, only: & set_cutoff implicit none real(kind=real64), intent(in), dimension(:) :: & cutoff call set_cutoff(cutoff) end subroutine set_cutoff_ subroutine get_cutoff_size_(n) use typedef, only: & int64 use parameters, only: & get_cutoff_size implicit none integer(kind=int64), intent(out) :: & n call get_cutoff_size(n) end subroutine get_cutoff_size_ subroutine get_cutoff_(cutoff, n) use typedef, only: & real64, int64 use parameters, only: & get_cutoff implicit none real(kind=real64), intent(out), dimension(n) :: & cutoff integer(kind=int64), intent(in) :: & n call get_cutoff(cutoff) end subroutine get_cutoff_ subroutine reset_cutoff_ use parameters, only: & reset_cutoff implicit none call reset_cutoff end subroutine reset_cutoff_ ! ----------------------------------------------------------------------- subroutine set_epslim_(val) use typedef, only: & real64 use parameters, only: & epslim implicit none real(kind=real64), intent(in) :: & val epslim = val end subroutine set_epslim_ subroutine get_epslim_(val) use typedef, only: & real64 use parameters, only: & epslim implicit none real(kind=real64), intent(out) :: & val val = epslim end subroutine get_epslim_ subroutine reset_epslim_() use parameters, only: & epslim, & epslim_default implicit none epslim = epslim_default end subroutine reset_epslim_ subroutine set_omegalim_(val) use typedef, only: & real64 use parameters, only: & omegalim implicit none real(kind=real64), intent(in) :: & val omegalim = val end subroutine set_omegalim_ subroutine get_omegalim_(val) use typedef, only: & real64 use parameters, only: & omegalim implicit none real(kind=real64), intent(out) :: & val val = omegalim end subroutine get_omegalim_ subroutine reset_omegalim_() use parameters, only: & omegalim, & omegalim_default implicit none omegalim = omegalim_default end subroutine reset_omegalim_ ! ----------------------------------------------------------------------- subroutine set_toffset_(toffset) use typedef, only: & real64 use stardata, only: & set_toffset implicit none real(kind=real64), intent(in) :: & toffset call set_toffset(toffset) end subroutine set_toffset_ subroutine add_stardata_(data, t0, id) use typedef, only: & real64, int64 use stardata, only: & add_stardata, random_stardata_id implicit none real(kind=real64), intent(in), dimension(:,:) :: & data real(kind=real64), intent(in) :: & t0 integer(kind=int64), intent(out) :: & id call add_stardata(data, t0) call random_stardata_id(id) end subroutine add_stardata_ subroutine get_stardata_id_(id) use typedef, only: & int64 use stardata, only: & get_stardata_id implicit none integer(kind=int64), intent(out) :: & id call get_stardata_id(id) end subroutine get_stardata_id_ subroutine set_stardata_id_(id) use typedef, only: & int64 use stardata, only: & set_stardata_id implicit none integer(kind=int64), intent(in) :: & id call set_stardata_id(id) end subroutine set_stardata_id_ subroutine clear_stardata_() use stardata, only: & clear_stardata implicit none call clear_stardata() end subroutine clear_stardata_ subroutine n_stardata_(count) use typedef, only: & int32 use stardata, only: & n_stardata implicit none integer(kind=int32), intent(out) :: & count count = n_stardata() end subroutine n_stardata_ subroutine direct_(t_, y, yp, ny_) use typedef, only: & int32, real64 use binary, only: & direct implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct(t_, y) end subroutine direct_ subroutine secular_(trel, y, yp, ny_) use typedef, only: & int32, real64 use binary, only: & secular implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & trel real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = secular(trel, y) end subroutine secular_ subroutine direct3h_(t_, y, yp, ny_) use typedef, only: & int32, real64 use ternary, only: & direct3h implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct3h(t_, y) end subroutine direct3h_ subroutine direct3f_(t_, y, yp, ny_) use typedef, only: & int32, real64 use ternary, only: & direct3f implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct3f(t_, y) end subroutine direct3f_ subroutine direct4p_(t_, y, yp, ny_) use typedef, only: & int32, real64 use quaternary, only: & direct4p implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct4p(t_, y) end subroutine direct4p_ subroutine direct4h_(t_, y, yp, ny_) use typedef, only: & int32, real64 use quaternary, only: & direct4p implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct4p(t_, y) end subroutine direct4h_ subroutine direct4f_(t_, y, yp, ny_) use typedef, only: & int32, real64 use quaternary, only: & direct4f implicit none integer(kind=int32), intent(in) :: & ny_ real(kind=real64), intent(in) :: & t_ real(kind=real64), intent(in), dimension(ny_) :: & y real(kind=real64), intent(out), dimension(ny_) :: & yp !f2py integer(kind=int32),intent(hide),depend(y) :: ny_=shape(y, 0) yp = direct4f(t_, y) end subroutine direct4f_ subroutine huntpol_(t, tt, nt, data, nv, val) use typedef, only: & int32, real64 use hunting, only: & huntpol implicit none real(kind=real64), intent(in) :: & t real(kind=real64), intent(in), dimension(nt) :: & tt real(kind=real64), intent(in), dimension(nt, nv) :: & data !f2py integer(kind=int32),intent(hide),depend(data) :: nt=shape(data, 0) !f2py integer(kind=int32),intent(hide),depend(data) :: nv=shape(data, 1) integer(kind=int32), intent(in) :: & nt, nv real(kind=real64), intent(out), dimension(nv) :: & val val(:) = huntpol(t, tt, nt, transpose(data), nv) end subroutine huntpol_ subroutine star_huntpol_(t, j, nv, val) use typedef, only: & int32, real64 use stardata, only: & star_huntpol implicit none real(kind=real64), intent(in) :: & t integer(kind=int32), intent(in) :: & j, nv real(kind=real64), intent(out), dimension(nv) :: & val val(:) = star_huntpol(t, j) end subroutine star_huntpol_ subroutine step_driver_(t0, y0, dt, nstep, nsave, dt0, dtmin, dtmax, yscale, & eps, tmax, tt, yy, n_, hnew, neval, nloop, mstep, ierr, mode) use typedef, only: & real64, int64 use unary, only: & direct1 use binary, only: & direct, secular use ternary, only: & direct3h, direct3f use quaternary, only: & direct4p, direct4h, direct4f use deriv_data, only: & MODE_DIRECT1, & MODE_DIRECT, MODE_SECULAR, & MODE_DIRECT3H, MODE_DIRECT3F, & MODE_DIRECT4P, MODE_DIRECT4H, MODE_DIRECT4F use driver, only: & step_driver use integrate, only: & template, regularize use errors, only: & IERR_INVALIDMODE use orientation, only: & regularize_orientation, & regularize_quaternion use flags_data, only: & use_ori, use_orq implicit none !f2py integer,intent(hide),depend(y0) :: n_=shape(y0, 0) !f2py integer,optional,intent(in) :: mode=1 real(kind=real64), intent(in) :: & t0, dt, dt0, eps, dtmin, dtmax real(kind=real64), intent(in), dimension(n_) :: & y0, yscale integer(kind=int64), intent(in) :: & n_, nstep, nsave, mode, tmax integer(kind=int64), intent(out) :: & ierr integer(kind=int64), intent(out) :: & neval, nloop, mstep real(kind=real64), intent(out), dimension(nsave) :: & tt real(kind=real64), intent(out), dimension(n_,nsave) :: & yy real(kind=real64), intent(out) :: & hnew ! local variables procedure(template), pointer :: & f procedure(regularize), pointer :: & r select case(mode) case(MODE_DIRECT) f => direct case(MODE_SECULAR) f => secular case(MODE_DIRECT3H) f => direct3h case(MODE_DIRECT3F) f => direct3f case(MODE_DIRECT4P) f => direct4p case(MODE_DIRECT4H) f => direct4h case(MODE_DIRECT4F) f => direct4f case(MODE_DIRECT1) f => direct1 case default ierr = IERR_INVALIDMODE neval = 0 nloop = 0 return end select if (use_ori) then if (use_orq) then r => regularize_quaternion else r => regularize_orientation end if else r => null() end if call step_driver(f, r, t0, y0, dt, dt0, dtmin, dtmax, yscale, & eps, nstep, nsave, tmax, n_, yy, tt, hnew, neval, nloop, mstep, ierr) end subroutine step_driver_ subroutine dynamic_driver_(t0, y0, dt, nstep, nsave, dt0, dtmin, dtmax, dtd, yscale, & eps, tmax, n_, hnew, neval, nloop, ierr, mode, iext, iflags) use typedef, only: & real64, int64 use unary, only: & direct1 use binary, only: & direct, secular use ternary, only: & direct3h, direct3f use quaternary, only: & direct4p, direct4h, direct4f use deriv_data, only: & MODE_DIRECT1, & MODE_DIRECT, MODE_SECULAR, & MODE_DIRECT3H, MODE_DIRECT3F, & MODE_DIRECT4P, MODE_DIRECT4H, MODE_DIRECT4F use driver, only: & dynamic_driver use integrate, only: & template, regularize use errors, only: & IERR_INVALIDMODE use orientation, only: & regularize_orientation, & regularize_quaternion use flags_data, only: & use_ori, use_orq implicit none !f2py integer,intent(hide),depend(y0) :: n_=shape(y0, 0) !f2py integer,optional,intent(in) :: mode=1 !f2py integer,optional,intent(in) :: iext=0 !f2py integer,optional,intent(in) :: iflags=0 real(kind=real64), intent(in) :: & t0, dt, dt0, dtd, eps, dtmin, dtmax real(kind=real64), intent(in), dimension(n_) :: & y0, yscale integer(kind=int64), intent(in) :: & n_, nstep, nsave, mode, tmax, iext, iflags integer(kind=int64), intent(out) :: & ierr, neval, nloop real(kind=real64), intent(out) :: & hnew ! local variables procedure(template), pointer :: & f procedure(regularize), pointer :: & r select case(mode) case(MODE_DIRECT) f => direct case(MODE_SECULAR) f => secular case(MODE_DIRECT3H) f => direct3h case(MODE_DIRECT3F) f => direct3f case(MODE_DIRECT4P) f => direct4p case(MODE_DIRECT4H) f => direct4h case(MODE_DIRECT4F) f => direct4f case(MODE_DIRECT1) f => direct1 case default ierr = IERR_INVALIDMODE neval = 0 nloop = 0 return end select if (use_ori) then if (use_orq) then r => regularize_quaternion else r => regularize_orientation end if else r => null() end if call dynamic_driver(f, r, t0, y0, dt, dt0, dtmin, dtmax, dtd, yscale, & eps, nstep, nsave, tmax, n_, hnew, neval, nloop, ierr, iext, iflags) end subroutine dynamic_driver_ subroutine dynamic_get_size_(ndata, ndim, mstep) use typedef, only: & int64 use integral_data, only: & get_ndata implicit none integer(kind=int64), intent(out) :: & ndata, ndim, mstep ! python could access module data directly call get_ndata(ndata, ndim, mstep) end subroutine dynamic_get_size_ subroutine dynamic_get_data_(coord, data, ndata, ndim) use typedef, only: & int64, real64 use integral_data, only: & get_data implicit none integer(kind=int64), intent(in) :: & ndata, ndim real(kind=real64), intent(out), dimension(ndata) :: & coord real(kind=real64), intent(out), dimension(ndim, ndata) :: & data call get_data(coord, data) end subroutine dynamic_get_data_ subroutine get_star_data_(tt, dd, ndata_, nstar, nd) use typedef, only: & int32, real64 use stardata, only: & get_star_data, NDATA implicit none integer(kind=int32), intent(in) :: & ndata_, nstar, nd real(kind=real64), intent(in), dimension(ndata_) :: & tt real(kind=real64), intent(out), dimension(nd, ndata_, nstar) :: & dd !f2py integer,intent(hide),depend(tt) :: ndata_=shape(tt, 0) !f2py integer,optional,intent(in) :: nstar=2 !f2py integer,optional,intent(in) :: nd=8 if (nd /= NDATA) ERROR STOP '[get_star_data_] DATA SIZE MISMATCH' call get_star_data(tt, dd) end subroutine get_star_data_ subroutine get_deriv_data_(tt, yy, dd, ndata_, nd_, nv, mode) ! TODO - update to have flags of what to return use typedef, only: & int32, real64 use deriv, only: & get_deriv_data use deriv_data, only: & MODE_N_CONST implicit none integer(kind=int32), intent(in) :: & ndata_, nd_, nv, mode real(kind=real64), intent(in), dimension(ndata_) :: & tt real(kind=real64), intent(in), dimension(nd_, ndata_) :: & yy real(kind=real64), intent(out), dimension(nv, ndata_) :: & dd !f2py integer,intent(hide),depend(yy) :: ndata_=shape(yy, 1) !f2py integer,intent(hide),depend(yy) :: nd_=shape(yy, 0) if (.not.MODE_N_CONST(mode)==nv) stop '[get_deriv_data_] invalid size request' if (.not.(size(tt,1)==ndata_)) stop '[get_deriv_data_] dimension mismatch tt, dd' call get_deriv_data(tt, yy, dd, mode) end subroutine get_deriv_data_ subroutine set_deriv_flags_(flags, old_flags) use typedef, only: & int64 use flags_data, only: & get_derivative_flags, & set_derivative_flags implicit none integer(kind=int64), intent(in) :: & flags integer(kind=int64), intent(out) :: & old_flags old_flags = get_derivative_flags() call set_derivative_flags(flags) end subroutine set_deriv_flags_ subroutine get_deriv_flags_(flags) use typedef, only: & int64 use flags_data, only: & get_derivative_flags implicit none integer(kind=int64), intent(out) :: & flags flags = get_derivative_flags() end subroutine get_deriv_flags_