Массив Fortran с динамическим размером, так же просто, как функция R seq ()
Я хотел бы написать код на Фортране, который работает как функция R seq (). Например.:
x <- seq(0,1,0.1)
даст вектор
x <- c(0, 0.1, 0.2, ..., 1)
Я проведу несколько симуляций, в течение которых длина последовательности будет меняться, в R это легко сделать, просто меняя второй аргумент в seq (). Я попытался сделать что-то подобное в Fortran с динамическими массивами и функцией ALLOCATE для динамического изменения размера массива. Это не работает до сих пор и приводит к ошибке
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x2B371ED7C7D7
#1 0x2B371ED7CDDE
#2 0x2B371F3B8FEF
#3 0x401BE9 in MAIN__ at test3D.f90:?
Segmentation fault (core dumped)
поэтому мне было интересно, есть ли простой способ имитировать поведение функции R seq () в Фортране.
Для дальнейшего ознакомления см. Программу ниже
program ffl
implicit none
integer, parameter :: n = 2**12
integer :: m,j,l,o,num,r,posi
real(kind=8), dimension(n) :: results
real(kind=8) :: dt,dk,dp, dtt, laenge, basal, periode,c
real(kind=8), dimension(n,n) :: fitness, k_opt
real(kind=8) :: t0,t1,t2,t3
real(kind=8), dimension(:),allocatable :: t
real(kind=8), dimension(n) :: k,p, tt1
real(kind=8), dimension(6) :: x_new, res, q0
real(kind=8), dimension(6) :: k1,k2,k3,k4
real(kind=8) :: ts = 0.0
real(kind=8) :: ks = 0.0, ke = 1.0
real(kind=8) :: ps = 0.1, pe = 40.0
real(kind=8) :: tts = 0.0, tte = 1.0
real(kind=8), dimension(6) :: u0,f1,f2,f3,u1
external :: derivate
! computing the vectors
dk=(ke-ks)/real(n) ! calculating resolution
dp=(pe-ps)/real(n) ! calculating resolution
dtt=(tte-tts)/real(n) ! calculating resolution
k(1) = ks ! first value for k = 0.0
p(1) = ps ! first value for p = 0.001
tt1(1) = tts ! first value for tts = 0.0
num = 10
do m = 1,n
k(m) = k(m-1)+dk ! setting the basal expression vector with resolution dt
tt1(m) = tt1(m-1)+dtt
end do
do m = 1,n
p(m) = ps + 0.1
end do
do m = 1,n
periode = p(m)
do j = 1,n
laenge = tt1(j)
do l = 1,n
basal = k(l)
c = num * periode ! calculating the length of the simulation
dt=(c-ts)/real(n) ! calculating time resolution
r = 1
t(1) = ts ! setting first time value to t1 = 0
allocate(t(1)) ! Initialize array dimension
do while (ts + dt < c)
t(r) = ts
ts = ts + dt
r = r + 1
call resize_array
end do
! initial conditions
q0(1) = 0 ! x
q0(2) = basal ! y
q0(3) = 0 ! z
q0(4) = 0 ! a
q0(5) = 1 ! b
q0(6) = 0 ! w
x_new = q0 ! set initial conditions
! Solving the model using a 4th order Runge-Kutta method
do o = 1,n
call derivate(basal,periode,laenge,t(l),x_new,k1)
t1 = t(o) + dt/2
f1 = x_new + (dt*k1)/2
call derivate(basal,periode,laenge,t1,f1,k2)
t2 = t(o) + dt/2
f2 = x_new + (dt*k2)/2
call derivate(basal,periode,laenge,t2,f2,k3)
t3 = t(o) + dt
f3 = x_new + (dt*k3)/2
call derivate(basal,periode,laenge,t3,f3,k4)
res = x_new + (dt*(k1+2*k2+2*k3+k4))/6
if (res(2) < basal) then
res(2) = basal
endif
results(n) = res(6)
end do
fitness(j,l) = maxval(results)/c
end do
write(*,*) fitness
!posi = maxloc(fitness(:,j))
!k_opt(m,j) = k(posi) ! inputting that value into the optimal k matrix
end do
end do
!write(*,*) k_opt
!return k_opt
contains
! The subroutine increases the size of the array by 1
subroutine resize_array
real,dimension(:),allocatable :: tmp_arr
integer :: new
new = size(t) + 1
allocate(tmp_arr(new))
tmp_arr(1:new)=t
deallocate(t)
allocate(t(size(tmp_arr)))
t=tmp_arr
end subroutine resize_array
end program ffl