Related
For example, I have kmeans code
program read_from_file
use functions_module
!$ use omp_lib
character(len=2) :: c2
integer :: i, j, k, l, c, d
real, dimension(:,:), allocatable :: r, centroid, new_centro, converge
real, dimension(:), allocatable :: cost
integer,dimension(:),allocatable :: indices,distancereg,cluster
integer :: ios_read = 0
integer :: n = 0
integer :: omega, tid, n_threads
real, dimension(:,:), allocatable :: comparison_value
print *, 'which data index?'
read*, idx
write(c2, '(i2.2)') idx
open(unit=99, file='datatest1.dat', iostat=ios_read)
if (ios_read /= 0) then
print *, "kmeans_data_distrib_"//c2//"_small.dat could not be opened"
! print
end if
!find the maximum lines
do
read(99, *, iostat=ios_read) i, x, y
if (ios_read > 0) then
print *, "something is wrong"
stop
else if (ios_read < 0) then
print *, "end of file reached"
exit
else
n = n+1
end if
end do
rewind(99)
!do i=1,n
open(unit=98, file='rawdata.dat')
allocate(r(2, n))
do i = 1,n
read(99, *, iostat=ios_read) j, x, y
r(1, j) = x
r(2, j) = y
write(98, *) x, y
end do
close(99) ! close kmeans
close(98) ! close rawdatai
print*, 'put k'
read*, k
allocate (comparison_value(2,k))
comparison_value = 0.02
** do l=1,10
call centroid_inits(r, n, k, centroid)
call min_distance(r, n, k, centroid, distance,indices,distancereg)
call new_centroid(r,n,k,centroid,indices,new_centro,omega)
call costfunction(r,n,k,distancereg,indices,new_centro,cluster,cost)
end do
open(unit=99,file="kmeans3_test.dat")
do i = 1, n
write(99,"(2es14.5,i4)") r(:,i),indices(i)
enddo
close(99)
Contains
subroutine centroid_inits(r,n,k,centroid)
real,dimension (:,:),intent(in),allocatable :: r
real,dimension (:,:),intent(out),allocatable:: centroid
real,dimension(k),allocatable::xc(:) ,yc(:)
integer,intent(in) :: n,k
integer :: i
real :: maks_x,maks_y,min_x,min_y
allocate(centroid(2, k))
allocate(xc(k))
allocate(yc(k))
maks_x = maxval(r(1,:))
maks_y = maxval(r(2,:))
min_x = minval(r(1,:))
min_y = minval(r(2,:))
! print *, min_x, maks_x, min_y, maks_y
do i = 1,k
xc (i) = min_x + (maks_x - min_x) * fib_rnd()
yc (i) = min_y + (maks_y - min_y) * fib_rnd()
centroid (1,i) = xc(i)
centroid (2,i) = yc(i)
end do
do i = 1,k
print *, centroid(:,i)
end do
end subroutine centroid_inits
subroutine min_distance(r,n,k,centroid,distance,indices,distancereg)
integer, intent(out):: n,k
real,dimension(:,:),intent(in),allocatable::centroid
real,dimension(:,:),intent(in),allocatable::r
integer,dimension(:),intent(out),allocatable::indices,distancereg
real ::d_min
integer::y,i_min,j,i
integer,parameter :: data_dim=2
allocate (indices(n))
allocate (distancereg(k))
!cost=0.d0
do j=1,n
i_min = -1
d_min=1.d6
! !$ OMP DO
do i=1,k
distance=0.d0
distancereg(i)=0.d0
do y=1,data_dim
distance = distance+abs(r(y,j)-centroid(y,i))
distancereg(i)=distancereg(i)+abs(r(y,j)-centroid(y,i))
end do
if (distance<d_min) then
d_min=distance
i_min=i
end if
end do
!!$OMP END DO
if( i_min < 0 ) print*," found error by assigning k-index to particle ",j
indices(j)=i_min
end do
end subroutine
subroutine new_centroid(r,n,k,centroid,indices,new_centro,omega)
integer, intent(in):: n
real,dimension(:,:),intent(inout),allocatable ::centroid
real,dimension(:,:),intent(in),allocatable ::r
integer,dimension(:),intent(in),allocatable::indices
real,dimension(:,:),intent(out),allocatable:: new_centro
integer,intent(inout)::k
integer :: t,y,j,k_ind
integer,intent(out) :: omega
real,dimension(:),allocatable :: summ
allocate(summ(2))
allocate (new_centro(2,k))
t=2
do k_ind=1,k
omega = count(indices==k_ind)
summ(1)=0
summ(2)=0
do j=1,n
if (indices(j)==k_ind) then
summ(1) =+ r(1,j)
summ(2) =+ r(2,j)
end if
end do
new_centro(1,k_ind) = summ(1)/omega
new_centro(2,k_ind) = summ(2)/omega
end do
centroid = new_centro
!do k_ind=1,k
!print*, 'new centro',new_centro(:,k_ind)
!end do
end subroutine
subroutine costfunction(r,n,k,distancereg,indices,new_centro,cluster,cost)
integer, dimension (:), allocatable, intent(out) :: distancereg, indices
integer, dimension (:), allocatable, intent(out) :: cluster
real, dimension (:,:), allocatable, intent(in) :: r
real, dimension (:,:), intent(in), allocatable :: new_centro
real, dimension(:), intent(out), allocatable :: cost
integer :: i,k
allocate(cluster(k))
allocate(cost(k))
allocate(distancereg(k))
call min_distance(r,n,k,centroid,distance,indices,distancereg)
cluster = 0
do i=1,k
cost(i)=0
cluster(i)=count(indices==i)
cost(i)=(1.0/cluster(i))*distancereg(i)
! print*,cost(i)
end do
print*," total sum of cluster members ",sum(cluster)," vs N ",n
end subroutine
subroutine convergence_value(converge, centroid, new_centro, cost, cluster)
real, dimension (:,:), intent(inout), allocatable :: new_centro
real, dimension (:,:), intent(inout), allocatable :: centroid
real, dimension(:), allocatable, intent(out):: cost
integer, dimension (:), allocatable, intent(out) :: cluster
real, dimension(:,:), intent (inout), allocatable:: converge
allocate(converge(2,k))
call centroid_inits(r, n, k, centroid)
call min_distance(r, n, k, centroid, distance,indices,distancereg)
call new_centroid(r,n,k,centroid,indices,new_centro,omega)
converge = (abs(centroid-new_centro))
print*, 'this is c',converge
end subroutine
end program read_from_file
It runs okay with serial. But I want to apply openmp. I want to each thread doing the same calculation and find which thread have better cost function and time. (all thread doing the clusterization). My attemp and idea is to paralellized the code before encounter the subroutine, that two asterisk. But I do not know if its enough (though I tried it and showing error), and how do make display report of each thread ?
*You might notice from the code that I am a beginner
I am trying to implement qsort algorithm in Fortran.
The implemented qsort is intended to operate over an array of a derived type which contains also another derived type.
The derived types are defined in a separate module as:
MODULE DATA_MODEL
! -------------------
! CONSTANTS
! -------------------
integer,parameter :: max_records = 100000000
type :: timestamp
integer :: year
integer :: month
integer :: day
integer :: hour
integer :: minute
integer :: second
end type
type :: tape
type(timestamp) :: ts
integer :: value1
integer :: value2
end type
END MODULE
This is what I have tried to implement the quicksort algorithm.
! DESCRIPTION:
! THIS MODULE IMPLEMENTS QSORT ALGORITH USING LOMUTO PARTITION SCHEME
! PSEUDOCODE:
! ALGORITHM QUICKSORT(A, LO, HI) IS
! IF LO < HI THEN
! P := PARTITION(A, LO, HI)
! QUICKSORT(A, LO, P - 1)
! QUICKSORT(A, P + 1, HI)
!
! ALGORITHM PARTITION(A, LO, HI) IS
! PIVOT := A[HI]
! I := LO
! FOR J := LO TO HI DO
! IF A[J] < PIVOT THEN
! SWAP A[I] WITH A[J]
! I := I + 1
! SWAP A[I] WITH A[HI]
! RETURN I
!
! SORTING THE ENTIRE ARRAY IS ACCOMPLOMISHED BY QUICKSORT(A, 0, LENGTH(A) - 1).
module qsort
use data_model
contains
subroutine quicksort(a, lo, hi)
implicit none
! SUBROUTINE PARAMETERS
type(tape),allocatable,intent(in out) :: a
integer,intent(in) :: lo, hi
! ALGORITHM INTERNAL VARIABLES
integer :: p
if (lo < hi) then
call partition(a, lo, hi, p)
call quicksort(a, lo, p - 1)
call quicksort(a, p + 1, hi)
end if
end subroutine
subroutine partition(a, lo, hi, p)
implicit none
! SUBROUTINE PARAMETERS
type(tape),allocatable,intent(inout) :: a
integer,intent(in) :: lo
integer,intent(in) :: hi
integer,intent(out) :: p
! ALGORITHM INTERNAL VARIABLES
type(tape) :: pivot
type(tape) :: swap
integer :: i,j
pivot = a(hi)
i = lo
do j = lo, hi
if (compare(a(j), pivot)) then
swap = a(i)
a(i) = a(j)
a(j) = swap
i = i + 1
endif
end do
swap = a(i)
a(i) = a(hi)
a(hi) = swap
p = i
end subroutine
function compare(a,b)
implicit none
! FUNCTION PARAMETERS
type(tape) :: a
type(tape) :: b
logical :: compare
if (a%ts%year < b%ts%year) then
compare = .true.
else if (a%ts%year > a%ts%year) then
compare = .false.
else if (a%ts%month < b%ts%month) then
compare = .true.
else if (a%ts%month > b%ts%month) then
compare = .false.
else if (a%ts%day < b%ts%day) then
compare = .true.
else if (a%ts%day > b%ts%day) then
compare = .false.
else if (a%ts%hour < b%ts%hour) then
compare = .true.
else if (a%ts%hour > b%ts%hour) then
compare = .false.
else if (a%ts%minute < b%ts%minute) then
compare = .true.
else if (a%ts%minute > b%ts%minute) then
compare = .false.
else if (a%ts%second < b%ts%second) then
compare = .true.
else if (a%ts%second > b%ts%second) then
compare = .false.
else
compare = .false.
end if
end function
end module
This is the errors I get while trying to compile it:
$ flang -c data_model.f95
$ flang -c qsort.f95
F90-S-0072-Assignment operation illegal to external procedure a (qsort.f95: 79)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 80)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 84)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 85)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 85)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 86)
0 inform, 0 warnings, 6 severes, 0 fatal for partition
$
Edit 1: I have modified the source code with the subroutine based code, which makes more sense as we want to modify the arguments.
Edit 2: modifying the definition of a to type(tape),intent(in out) :: a(:) in both quicksort and partition subroutines make the module to compile without errors – see comments.
I saw that you got unblocked with your problem with the help of the comments, but let me give you some suggestions to make your implementation more modular, easy to use and modern.
Disclaimer: Some of my suggestions might need a more recent Fortran version than 95.
You can improve your timestamp type definition by providing overloads for the relational operators.
type :: timestamp
integer :: year, month, day, hour = 0, minute = 0, second = 0
contains
procedure, private :: eq, ne, gt, ge, lt, le
generic :: operator(==) => eq
generic :: operator(/=) => ne
generic :: operator(>) => gt
generic :: operator(>=) => ge
generic :: operator(<) => lt
generic :: operator(<=) => le
end type
(A subtle change there is that I have default values for hour, minute and second. So you can instantiate like this: timestamp(2021,5,22))
To get this working, you just need to provide implementations for the functions eq, ne, gt, ge, lt, le available in the module you define your type. Note that, when writing a generic type bound procedure, you must declare your bound parameter as class(timestamp) instead of type(timestamp).
elemental function lt(left, right) result(result)
class(timestamp), intent(in) :: left, right
logical :: result
result = compare(left, right) < 0
end function
elemental function compare(this, other) result(result)
class(timestamp), intent(in) :: this, other
integer :: result
if (this%year /= other%year) then
result = sign(1, this%year - other%year)
else if (this%month /= other%month) then
result = sign(1, this%month - other%month)
else if (this%day /= other%day) then
result = sign(1, this%day - other%day)
else if (this%hour /= other%hour) then
result = sign(1, this%hour - other%hour)
else if (this%minute /= other%minute) then
result = sign(1, this%minute - other%minute)
else if (this%second /= other%second) then
result = sign(1, this%second - other%second)
else
result = 0
end if
end function
Another good practice you can implement is to control access of your module elements by using public and private.
module data_model
implicit none
public :: timestamp, tape
private
type :: timestamp
! (...)
end type
type :: tape
type(timestamp) :: ts
integer :: value1, value2
end type
contains
! (...) implementations of eq, ne, gt, ge, lt, le
end
Then, when you use this module from another program unit, only the public names will be available. You can also use only specific name with the use only clause:
module qsort
use data_model, only: tape
implicit none
public :: quicksort
private
contains
! (...) your quicksort implementation
end
Finally, let me suggest some tweaks on your quicksort implementation.
First, I suggest that you don't need to pass around the boundaries lo and hi everywhere together with your array. One of the most distinctive features of Fortran is how easy it is to operate on array segments. You can call the quicksort procedure on a contiguous portion of your array, and the procedure can work on it in a boundaries-agnostic way, if you use assumed-shape arrays, like this: type(tape) :: a(:). Inside the procedure, the array segment is rebounded to start on index 1, no matter what are the bounds on the call site.
Besides that, as I mentioned in the comments, you don't need to declare the array argument as allocatable in this case. Even if the original array you are passing is originally allocatable, you can pass an allocatable array to a procedure without declaring the argument as allocatable in the procedure, it will be handled as a normal array. It only makes sense to declare the argument as allocatable if you plan to allocate/deallocate inside the procedure.
pure recursive subroutine quicksort(a)
type(tape), intent(inout) :: a(:)
integer :: p
if (size(a) == 0) return
call partition(a, p)
call quicksort(a(:p-1))
call quicksort(a(p+1:))
end
I declared this procedure as pure in this case, but that would depend on your specific use case. Making it pure helps me to remind declaring intents correctly and have well-though procedures (and there is a performance gain in some cases), but this brings many restrictions (like not being able to print inside the procedure). You can search for pure procedures to learn more.
Both quicksort and partition are implemented as subroutines here. I like to do this way always that the procedure performs important side-effects, like updates on the passed argument. If I need a returned value, I can have an intent(out) argument, like the argument out in partition, that returns the pivot position.
pure subroutine partition(a, out)
type(tape), intent(inout) :: a(:)
integer, intent(out) :: out
integer :: i, j
i = 1
do j = 1, size(a)
if (a(j)%ts < a(size(a))%ts) then
call swap(a(i), a(j))
i = i + 1
end if
end do
call swap(a(i), a(size(a)))
out = i
end
elemental subroutine swap(a, b)
type(tape), intent(inout) :: a, b
type(tape) :: temp
temp = a
a = b
b = temp
end
You may note at a(j)%ts < a(size(a))%ts that I am making use of the overloaded operator < to compare two timestamp. This way, the comparison logic belongs to the same module as the type definition.
Finally, you can use the modules and make some tests on your quicksort implementation!
program main
use data_model, only: tape, timestamp
use qsort, only: quicksort
implicit none
type(tape) :: a(8) = [ &
tape(timestamp(2020, 01, 08), 0, 0), &
tape(timestamp(2021, 01, 30), 0, 0), &
tape(timestamp(2020, 01, 06), 0, 0), &
tape(timestamp(2019, 12, 14), 0, 0), &
tape(timestamp(2020, 01, 08), 0, 0), &
tape(timestamp(2020, 05, 05), 0, 0), &
tape(timestamp(2021, 04, 30), 0, 0), &
tape(timestamp(2020, 10, 22), 0, 0) &
]
call quicksort(a(3:7)) ! will sort in place, only from index 3 to 7
call quicksort(a) ! will sort whole array
end
Works like a charm!
This is not an answer directly related to the quicksort algorithm but rather on how to implement type-bound operators.
You can move the compare function inside the data_model module.
This decouples the modules further s.t. the quicksort module only contains the quicksort algorithm.
The compare function can be implemented by a type-bound operator operator(<).
The following shows a quick implementation (only for year/month/day) and it should help you to edit your own code accordingly.
module timestamp_m
implicit none
private
public timestamp
type timestamp
integer :: y, m, d
contains
generic :: operator(<) => timestamp_lt
procedure, private :: timestamp_lt
end type
contains
logical function timestamp_lt(this, rhs) result(tf)
!! result of: this < rhs
class(timestamp), intent(in) :: this
type(timestamp), intent(in) :: rhs
! compare year
if (this%y < rhs%y) then
tf = .true.
else if (this%y > rhs%y) then
tf = .false.
else
! compare month
if (this%m < rhs%m) then
tf = .true.
else if (this%m > rhs%m) then
tf = .false.
else
! compare day
if (this%d < rhs%d) then
tf = .true.
else
tf = .false.
end if
end if
end if
end function
end module
You will need to adjust one line in your quicksort module:
module qsort
..
subroutine quicksort(a, lo, hi)
..
! if (compare(a(j), pivot)) then ! OLD. replace by:
if (a(j)%ts < pivot%ts) then
..
I have this subroutine :
subroutine FotranDgemmMatrixMultiplication(A, B, C, m, n, p, mkl)
integer m, n, p
real*8 mkl
real*8 A(m,n), B(n,p), C(m,p)
if (mkl .ne. 1) then
C = matmul(A,B)
else
C = matmul(B,A)
endif
end
that I use in a mex gateway file as follows :
#include <fintrf.h>
C The gateway routine
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
implicit none
mwPointer mxGetM, mxGetN, mxIsNumeric, mxIsLogical
mwPointer mxCreateDoubleMatrix
mwPointer plhs(*), prhs(*)
mwPointer A_pr, B_pr, C_pr, mkl_pr
mwPointer mxGetPr
integer nlhs, nrhs
real*8, allocatable, dimension(:,:) :: x, y, z
real*8 mkl
mwSize m, n, p, q, r, s
mwSize size1, size2, size3
C Check for proper number of arguments.
if (nrhs .ne. 3) then
call mexErrMsgTxt('Three inputs required.')
elseif (nlhs .ne. 1) then
call mexErrMsgTxt('One output required.')
endif
C Check to see both inputs are numeric.
if (mxIsNumeric(prhs(1)) .ne. 1) then
call mexErrMsgTxt('Input #1 is not a numeric array.')
elseif (mxIsNumeric(prhs(2)) .ne. 1) then
call mexErrMsgTxt('Input #2 is not a numeric array.')
elseif (mxIsNumeric(prhs(3)) .ne. 1) then
call mexErrMsgTxt('Input #3 is not a numeric array.')
endif
C Get the size of the input matrix #1.
m = mxGetM(prhs(1))
n = mxGetN(prhs(1))
C Get the size of the input matrix #2.
p = mxGetM(prhs(2))
q = mxGetN(prhs(2))
C Check that the sizes are compatible for a matrix product
if (n .ne. p) then
call mexErrMsgTxt('nbcol1 should be equal to nbrow2.')
endif
size1 = m*n
size2 = p*q
C Check that the input #3 is a scalar
r = mxGetM(prhs(3))
s = mxGetN(prhs(3))
if(r .ne. 1 .or. s .ne. 1) then
call mexErrMsgTxt('Input #3 is not a scalar.')
endif
C Create matrix for the return argument.
plhs(1) = mxCreateDoubleMatrix(m, q, 0)
A_pr = mxGetPr(prhs(1))
B_pr = mxGetPr(prhs(2))
mkl_pr = mxGetPr(prhs(3))
C_pr = mxGetPr(plhs(1))
allocate( x(m,n), y(p,q), z(m,q) )
C Load the data into Fortran arrays.
call mxCopyPtrToReal8(A_pr, x, size1)
call mxCopyPtrToReal8(B_pr, y, size2)
call mxCopyPtrToReal8(mkl_pr, mkl, 1) ! suspicious line
C Call the computational subroutine.
call FotranDgemmMatrixMultiplication(x, y, z, m, n, q, mkl) ! crash here
C Load the output into a MATLAB array.
size3 = m*q
call mxCopyReal8ToPtr(z, C_pr, size3)
!deallocate(x,y,z)
return
end
that executes as intended in debug but that crashes in release, the crash occuring at line :
call FotranDgemmMatrixMultiplication(x, y, z, m, n, q, mkl)
If I add a mwSize sizeOne with sizeOne = 1 and replace the suspicious line (see the code) with :
call mxCopyPtrToReal8(mkl_pr, mkl, sizeOne)
then the crash doesn't occur anymore. I don't understand what is happening as in x64 the "type" mwSize is defined (in fintrf.h) as mwpointer which itself is defined as integer*4, which should treat the "constant" 1 correctly normally.
I am trying to get a solution for the Rossler attractor system using RK-4, with parameters a=0.2, b=0.2, c=6 and initial conditions x0=-5.6, y0=0, z0=0. I tried solving using Fortran but the result is only displaying the initial conditions even after 1000 iterations. What mistakes am I making?
implicit none
external rossler
integer::i,j=0,n,nstep
real::a,b,c,y1(3),t0,dt,t1,t2,ya(3),yb(3),yd(3),t,x0,y0,z0,x(1000),y(1000),z(1000),k1(3),k2(3),k3(3),k4(3),h
print *, "enter the values of a,b,c"
read (*,*) a,b,c
print *, "enter the values of x0,y0,z0"
read (*,*) x0,y0,z0
n=3
t0=0.0
h=0.05
ya(1)=x0
ya(2)=y0
ya(3)=z0
nstep=1000
do i=1,nstep
t1=t0
t2=t0+h
call rk4(rossler,t1,t2,1,N,k1,k2,k3,k4,Ya,Y1,Yb)
x(i)=ya(1)
y(i)=ya(2)
z(i)=ya(3)
open (99,file="rossler.txt")
write(99,*) x(i),y(i),z(i)
end do
end program
subroutine rossler(T,Yd,YB,N)
implicit none
integer n
real t,yb(n),yd(n),a,b,c
yd(1)=-yb(2)-yb(3)
Yd(2)=yb(1)+a*yb(2)
Yd(3)=b+yb(3)*(yb(1)-c)
return
end
subroutine rk4(rossler,t1,t2,nstep,N,k1,k2,k3,k4,Ya,Y1,Yb)
implicit none
external rossler
integer nstep,n,i,j
REAL T1,T2,Ya(N),k1(n),k2(n),k3(n),k4(n),H,Y1(N),T,yb(n)
T=T1+(I-1)*H
CALL rossler(T,Yb,Ya,N)
DO J=1,N
k1(j)=YB(J)*H
end do
CONTINUE
CALL rossler(T+0.5*H,Yb,Ya+k1*0.5,N)
DO J=1,N
k2(j)=YB(J)*H
enddo
CONTINUE
CALL rossler(T+0.5*H,Yb,Ya+k2*0.5,N)
DO J=1,N
K3(J)=YB(J)*H
enddo
CONTINUE
CALL rossler(T+H,Yb,Ya+k3,N)
DO J=1,n
K4(J)=YB(J)*H
Y1(J)=Ya(J)+(k1(j)+k4(j)+2.0*(k2(j)+k3(j)))/6.0
enddo
CONTINUE
DO J=1,N
Ya(J)=Y1(j)
enddo
CONTINUE
enddo
RETURN
END
Although the question seems a duplicate of another question, here I am attaching a minimally modified code so that the OP can compare it with the original one. The essential modifications are that I have removed all the unused variables, moved a, b, c, and h to a parameter module, and cleaned up unnecessary statements (like CONTINUE). No newer features of Fortran introduced (including interface block for rossler), so it is hopefully straight-forward to see how the code has been changed.
module params
real :: a, b, c, h
end module
program main
use params, only: a, b, c, h
implicit none
external rossler
integer :: i, n, nstep
real :: t, y(3)
a = 0.2
b = 0.2
c = 5.7
n = 3
t = 0.0
h = 0.05
y(1) = -5.6
y(2) = 0.0
y(3) = 0.0
nstep = 7000
open(99, file="rossler.txt")
do i = 1,nstep
call rk4 ( rossler, t, n, y )
write(99,*) y(1), y(2), y(3)
end do
end program
subroutine rossler ( t, dy, y, n )
use params, only: a, b, c
implicit none
integer n
real t, dy(n), y(n)
dy(1) = -y(2) - y(3)
dy(2) = y(1) + a * y(2)
dy(3) = b + ( y(1) - c ) * y(3)
end
subroutine rk4 ( deriv, t, n, y )
use params, only: h
implicit none
external deriv
integer n, j
real y(n), t, k1(n), k2(n), k3(n), k4(n), d(n)
call deriv ( t, d, y, n )
do j = 1,n
k1(j) = d(j) * h
enddo
call deriv ( t+0.5*h, d, y+k1*0.5, n )
DO j = 1,n
k2(j) = d(j) * h
enddo
call deriv ( t+0.5*h, d, y+k2*0.5, n )
do j = 1,n
k3(j) = d(j) * h
enddo
call deriv ( t+h, d, y+k3, n )
do j = 1,n
k4(j) = d(j) * h
y(j) = y(j) + ( k1(j) + k4(j) + 2.0 * (k2(j) + k3(j)) ) / 6.0
enddo
t = t + h
end
By choosing the parameters as a = 0.2, b = 0.2, c = 5.7 and nstep = 7000, the modified code gave the so-called Rössler attractor, which is very beautiful and appears close in pattern to that displayed in the Wiki page. So with the minimal modifications, I believe the OP will also get a similar picture (it may be interesting to see how the pattern changes depending on parameters).
2D projection of the trajectory onto the xy plane:
The problem here is exactly the same as in another question, although I can no longer vote to close as a duplicate.
To make explicit and add the comments on the question: a, b and c take the place of omega from that question; the subroutine rossler as the function fcn.
An answer to that question addresses how this issue can be resolved.
I want to allocate memory for a matrix filled with double elements with Fortran 90, below is the corresponding C code:
int dim = 1024;
double *M = (double *)malloc(dim*dim*sizeof(double));
I wrote the code below but I could not access M(i) with i>=100:
program matrix
INTEGER :: i,d
CHARACTER(len=32) :: arg
REAL*8 M(*)
POINTER(ptr_M, M)
d=0
if(iargc() == 1) then
call getarg(1, arg)
read(arg, '(I10)') d
end if
print '("Dimension=", i6)', d
!allocate and init matrix
ptr_M = malloc(d*d*8)
do i=1,d*d
M(i) = i
end do
print '("M(i)=", f7.4)', M(100)
call free(ptr_M)
end program matrix
what's wrong?
Thanks to all, here is my final solution:
program matrix
IMPLICIT NONE
REAL, ALLOCATABLE :: M(:,:)
INTEGER :: i, j, d
CHARACTER(len=32) :: arg
!specify dimension with programm parameter
if(iargc() == 1) then
call getarg(1, arg)
read(arg, '(I10)') d
end if
!create and init matrix
ALLOCATE (M(d, d))
do i=1,d
do j=1,d
M(i, j) = (i - 1)*d+j
write (*,*) "M(",i,",",j,")=",M(i, j)
end do
end do
DEALLOCATE (M)
end program matrix
Using an ALLOCATABLE array, you can allocate a matrix with 100 rows and 200 columns as follows:
program xalloc
real, allocatable :: x(:,:)
allocate(x(100,200))
end program xalloc