Related
I need a general program in fortran to obtain all possible combinations of r elements in a list of n elements. I have found this code that prints all the combinations (r=3, n =5) but I need them to be stored in an array.
I tried to record them as rows near the write statement but it does not work. Turning the recursive subprogram into a recursive function is also not working.
program combinations
implicit none
integer, parameter :: m_max = 3
integer, parameter :: n_max = 5
integer, dimension (m_max) :: comb
character (*), parameter :: fmt = '(i0' // repeat (', 1x, i0', m_max - 1) // ')'
call gen (1)
contains
recursive subroutine gen (m)
implicit none
integer, intent (in) :: m
integer :: n
if (m > m_max) then
write (*, fmt) comb
else
do n = 1, n_max
if ((m == 1) .or. (n > comb (m - 1))) then
comb (m) = n
call gen (m + 1)
end if
end do
end if
end subroutine gen
end program combinations
Firstly, mixing global variables and recursive procedures is a good way to cause a lot of unnecessary confusion and debugging, so let's turn comb and n_max into procedure arguments, use size(comb) to give m_max, and for now replace fmt with *:
program combinations
implicit none
integer :: comb(3)
call gen(comb, 1, 5)
contains
recursive subroutine gen(comb, m, n_max)
integer, intent(inout) :: comb(:)
integer, intent(in) :: m
integer, intent(in) :: n_max
integer :: n
if (m > size(comb)) then
write (*, *) comb
else
do n = 1, n_max
if ((m == 1) .or. (n > comb(m - 1))) then
comb(m) = n
call gen(comb, m+1, n_max)
end if
end do
end if
end subroutine gen
end program combinations
The next thing to note is there's a subtle bug in your code. The line
if ((m == 1) .or. (n > comb (m - 1))) then
isn't guaranteed to work if m=1. Fortran does not guarantee short-circuiting of logical operators, so even if (m == 1) evaluates to .true., the (n > comb (m - 1)) could be evaluated, causing a segfault. Let's get around this by introducing a variable n_min, and calculating it correctly:
recursive subroutine gen(comb, m, n_max)
integer, intent(inout) :: comb(:)
integer, intent(in) :: m
integer, intent(in) :: n_max
integer :: n
integer :: n_min
if (m > size(comb)) then
write (*, *) comb
else
if (m == 1) then
n_min = 1
else
n_min = comb(m-1) + 1
endif
do n = n_min, n_max
comb(m) = n
call gen (comb, m+1, n_max)
end do
end if
end subroutine gen
Okay, now we can start thinking about returning the combinations from gen. To do this, let's change gen from a subroutine into a function, and have it return a 2-D array. We're going to need to append one 2-D array onto another, so let's write a function to do that now:
function append_combinations(input, new_combinations) result(output)
integer, intent(in) :: input(:,:)
integer, intent(in) :: new_combinations(:,:)
integer, allocatable :: output(:,:)
allocate(output(size(input,1), size(input,2)+size(new_combinations,2)))
output(:, :size(input,2)) = input
output(:, size(input,2)+1:) = new_combinations
end function
and now the whole program looks like
program combinations
implicit none
integer :: comb(3)
integer, allocatable :: combs(:,:)
integer :: i
combs = gen(comb, 1, 5)
write(*, *) ""
do i=1,size(combs,2)
write(*, *) combs(:,i)
enddo
contains
recursive function gen(comb, m, n_max) result(combs)
integer, intent(inout) :: comb(:)
integer, intent(in) :: m
integer, intent(in) :: n_max
integer, allocatable :: combs(:,:)
integer :: n
integer :: n_min
integer, allocatable :: new_combs(:,:)
if (m > size(comb)) then
write (*, *) comb
combs = reshape(comb, [size(comb),1])
else
if (m == 1) then
n_min = 1
else
n_min = comb(m-1) + 1
endif
allocate(combs(size(comb), 0))
do n = n_min, n_max
comb(m) = n
new_combs = gen(comb, m+1, n_max)
combs = append_combinations(combs, new_combs)
end do
end if
end function gen
function append_combinations(input, new_combinations) result(output)
integer, intent(in) :: input(:,:)
integer, intent(in) :: new_combinations(:,:)
integer, allocatable :: output(:,:)
allocate(output(size(input,1), size(input,2)+size(new_combinations,2)))
output(:, :size(input,2)) = input
output(:, size(input,2)+1:) = new_combinations
end function
end program combinations
I am trying to import a number of Fortran 90 codes into R for a project. They were initially written with a mex (matlab integration of Fortran routines) type compilation in mind. This is what one of the codes look like:
# include <fintrf.h>
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
!--------------------------------------------------------------
! MEX file for VFI3FCN routine
!
! log M_{t,t+1} = log \beta + gamma (x_t - x_{t+1})
! gamma = gamA + gamB (x_t - xbar)
!
!--------------------------------------------------------------
implicit none
mwPointer plhs(*), prhs(*)
integer nlhs, nrhs
mwPointer mxGetM, mxGetPr, mxCreateDoubleMatrix
mwPointer nk, nkp, nz, nx, nh
mwSize col_hxz, col_hz, col_xz
! check for proper number of arguments.
if(nrhs .ne. 31) then
call mexErrMsgTxt('31 input variables required.')
elseif(nlhs .ne. 4) then
call mexErrMsgTxt('4 output variables required.')
endif
! get the size of the input array.
nk = mxGetM(prhs(5))
nx = mxGetM(prhs(7))
nz = mxGetM(prhs(11))
nh = mxGetM(prhs(14))
nkp = mxGetM(prhs(16))
col_hxz = nx*nz*nh
col_xz = nx*nz
col_hz = nz*nh
! create matrix for the return arguments.
plhs(1) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(2) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(3) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(4) = mxCreateDoubleMatrix(nk, col_hxz, 0)
call vfi3fcnIEccB(%val(mxGetPr(plhs(1))), nkp)
return
end
subroutine vfi3fcnIEccB(optK, V, I, div, & ! output variables
alp1, alp2, alp3, V0, k, nk, x, xbar, nx, Qx, z, nz, Qz, h, nh, kp, &
alpha, beta, delta, f, gamA, gamB, gP, gN, istar, kmin, kmtrx, ksubm, hmtrx, xmtrx, zmtrx, &
nkp, col_hxz, col_xz, col_hz)
use ifwin
implicit none
! specify input and output variables
integer, intent(in) :: nk, nkp, nx, nz, nh, col_hxz, col_xz, col_hz
real*8, intent(out) :: V(nk, col_hxz), optK(nk, col_hxz), I(nk, col_hxz), div(nk, col_hxz)
real*8, intent(in) :: V0(nk, col_hxz), k(nk), kp(nkp), x(nx), z(nz), Qx(nx, nx), Qz(nz, nz), h(nh)
real*8, intent(in) :: alp1, alp2, alp3, xbar, kmin, alpha, gP, gN, beta, delta, gamA, gamB, f, istar
real*8, intent(in) :: kmtrx(nk, col_hxz), ksubm(nk, col_hz), zmtrx(nk, col_hxz), xmtrx(nk, col_hxz), hmtrx(nk, col_hxz)
! specify intermediate variables
real*8 :: Res(nk, col_hxz), Obj(nk, col_hxz), optKold(nk, col_hxz), Vold(nk, col_hxz), tmpEMV(nkp, col_hz), tmpI(nkp), &
tmpObj(nkp, col_hz), tmpA(nk, col_hxz), tmpQ(nx*nh, nh), detM(nx), stoM(nx), g(nkp), tmpInd(nh, nz)
real*8 :: Qh(nh, nh, nx), Qxh(nx*nh, nx*nh), Qzxh(col_hxz, col_hxz)
real*8 :: hp, d(nh), errK, errV, T1, lapse
integer :: ix, ih, iter, optJ(col_hz), ik, iz, ind(nh, col_xz), subindex(nx, col_hz)
logical*4 :: statConsole
! construct the transition matrix for kh --- there are nx number of these transition matrix: 3-d
Qh = 0.0
do ix = 1, nx
do ih = 1, nh
! compute the predicted next period kh
hp = alp1 + alp2*h(ih) + alp3*(x(ix) - xbar)
! construct transition probability vector
d = abs(h - hp) + 1D-32
Qh(:, ih, ix) = (1/d)/sum(1/d)
end do
end do
! construct the compound transition matrix over (z x h) space
! compound the (x h) space
Qxh = 0.0
do ix = 1, nx
call kron(tmpQ, Qx(:, ix), Qh(:, :, ix), nx, 1, nh, nh)
Qxh(:, (ix - 1)*nh + 1 : ix*nh) = tmpQ
end do
! compound the (z x h) space: h changes the faster, followed by x, and z changes the slowest
call kron(Qzxh, Qz, Qxh, nz, nz, nx*nh, nx*nh)
! available funds for the firm
Res = dexp(xmtrx + zmtrx + hmtrx)*(kmtrx**alpha) + (1 - delta)*kmtrx - f
! initializing
Obj = 0.0
optK = 0.0
optKold = optK + 1.0
Vold = V0
! Some Intermediate Variables Used in Stochastic Discount Factor
detM = beta*dexp((gamA - gamB*xbar)*x + gamB*x**2)
stoM = -(gamA - gamB*xbar + gamB*x)
! Intermediate index vector to facilitate submatrix extracting
ind = reshape((/1 : col_hxz : 1/), (/nh, col_xz/))
do ix = 1, nx
tmpInd = ind(:, ix : col_xz : nx)
do iz = 1, nz
subindex(ix, (iz - 1)*nh + 1 : iz*nh) = tmpInd(:, iz)
end do
end do
! start iterations
errK = 1.0
errV = 1.0
iter = 0
T1 = secnds(0.0)
do
if (errV <= 1D-3 .AND. errK <= 1D-8) then
exit
else
iter = iter + 1
do ix = 1, nx
! next period value function by linear interpolation: nkp by nz*nh matrix
call interp1(tmpEMV, k, detM(ix)*(matmul(dexp(stoM(ix)*xmtrx)*Vold, Qzxh(:, subindex(ix, :)))) - ksubm, kp, &
nk, nkp, col_hz)
! maximize the right-hand size of Bellman equation on EACH grid point of capital stock
do ik = 1, nk
! with istar tmpI is no longer investment but a linear transformation of that
tmpI = (kp - (1.0 - delta)*k(ik))/k(ik) - istar
where (tmpI >= 0.0)
g = gP
elsewhere
g = gN
end where
tmpObj = tmpEMV - spread((g/2.0)*(tmpI**2)*k(ik), 2, col_hz)
! direct discrete maximization
Obj(ik, subindex(ix, :)) = maxval(tmpObj, 1)
optJ = maxloc(tmpObj, 1)
optK(ik, subindex(ix, :)) = kp(optJ)
end do
end do
! update value function and impose limited liability condition
V = max(Res + Obj, 1D-16)
! convergence criterion
errK = maxval(abs(optK - optKold))
errV = maxval(abs(V - Vold))
! revise Initial Guess
Vold = V
optKold = optK
! visual
if (modulo(iter, 50) == 0) then
lapse = secnds(T1)
statConsole = AllocConsole()
print "(a, f10.7, a, f10.7, a, f8.1, a)", " errV:", errV, " errK:", errK, " Time:", lapse, "s"
end if
end if
end do
! visual check on errors
lapse = secnds(T1)
statConsole = AllocConsole()
print "(a, f10.7, a, f10.7, a, f8.1, a)", " errV:", errV, " errK:", errK, " Time:", lapse, "s"
! optimal investment and dividend
I = optK - (1.0 - delta)*kmtrx
tmpA = I/kmtrx - istar
where (tmpA >= 0)
div = Res - optK - (gP/2.0)*(tmpA**2)*kmtrx
elsewhere
div = Res - optK - (gN/2.0)*(tmpA**2)*kmtrx
end where
return
end
subroutine interp1(v, x, y, u, m, n, col)
!-------------------------------------------------------------------------------------------------------
! Linear interpolation routine similar to interp1 with 'linear' as method parameter in Matlab
!
! OUTPUT:
! v - function values on non-grid points (n by col matrix)
!
! INPUT:
! x - grid (m by one vector)
! y - function defined on the grid x (m by col matrix)
! u - non-grid points on which y(x) is to be interpolated (n by one vector)
! m - length of x and y vectors
! n - length of u and v vectors
! col - number of columns of v and y matrices
!
! Four ways to pass array arguments:
! 1. Use explicit-shape arrays and pass the dimension as an argument(most efficient)
! 2. Use assumed-shape arrays and use interface to call external subroutine
! 3. Use assumed-shape arrays and make subroutine internal by using "contains"
! 4. Use assumed-shape arrays and put interface in a module then use module
!
! This subroutine is equavilent to the following matlab call
! v = interp1(x, y, u, 'linear', 'extrap') with x (m by 1), y (m by col), u (n by 1), and v (n by col)
!------------------------------------------------------------------------------------------------------
implicit none
integer :: m, n, col, i, j
real*8, intent(out) :: v(n, col)
real*8, intent(in) :: x(m), y(m, col), u(n)
real*8 :: prob
do i = 1, n
if (u(i) < x(1)) then
! extrapolation to the left
v(i, :) = y(1, :) - (y(2, :) - y(1, :)) * ((x(1) - u(i))/(x(2) - x(1)))
else if (u(i) > x(m)) then
! extrapolation to the right
v(i, :) = y(m, :) + (y(m, :) - y(m-1, :)) * ((u(i) - x(m))/(x(m) - x(m-1)))
else
! interpolation
! find the j such that x(j) <= u(i) < x(j+1)
call bisection(x, u(i), m, j)
prob = (u(i) - x(j))/(x(j+1) - x(j))
v(i, :) = y(j, :)*(1 - prob) + y(j+1, :)*prob
end if
end do
end subroutine interp1
subroutine bisection(list, element, m, k)
!--------------------------------------------------------------------------------
! find index k in list such that (list(k) <= element < list(k+1)
!--------------------------------------------------------------------------------
implicit none
integer*4 :: m, k, first, last, half
real*8 :: list(m), element
first = 1
last = m
do
if (first == (last-1)) exit
half = (first + last)/2
if ( element < list(half) ) then
! discard second half
last = half
else
! discard first half
first = half
end if
end do
k = first
end subroutine bisection
subroutine kron(K, A, B, rowA, colA, rowB, colB)
!--------------------------------------------------------------------------------
! Perform K = kron(A, B); translated directly from kron.m
!
! OUTPUT:
! K -- rowA*rowB by colA*colB matrix
!
! INPUT:
! A -- rowA by colA matrix
! B -- rowB by colB matrix
! rowA, colA, rowB, colB -- integers containing shape information
!--------------------------------------------------------------------------------
implicit none
integer, intent(in) :: rowA, colA, rowB, colB
real*8, intent(in) :: A(rowA, colA), B(rowB, colB)
real*8, intent(out) :: K(rowA*rowB, colA*colB)
integer :: t1(rowA*rowB), t2(colA*colB), i, ia(rowA*rowB), ja(colA*colB), ib(rowA*rowB), jb(colA*colB)
t1 = (/ (i, i = 0, (rowA*rowB - 1)) /)
ia = int(t1/rowB) + 1
ib = mod(t1, rowB) + 1
t2 = (/ (i, i = 0, (colA*colB - 1)) /)
ja = int(t2/colB) + 1
jb = mod(t2, colB) + 1
K = A(ia, ja)*B(ib, jb)
end subroutine kron
My initial plan was to remove the mexFunction subroutine and compile the main Fortran subroutines using the R CMD SHLIB command but then I run into the Rtools compiler not knowing where to find the ifwin library even though I have the library in my intel fortran compiler folder.
So my first question is:
1) Is there a way for me to tell rtools where to find the ifwin library and any other library I need to include? Or is there a way to include the dependency libraries in the R CMD SHLIB command so the compiler can find the necessary libraries and compile?
2) If the answer to two is no, can I some how use the compiled version from Matlab in R. I can compile the file as is in matlab using the mex Zhang_4.f90 command with no errors.
3) Is there a way of setting up an environment in Visual Studio 2015 so I can compile Fortran subroutines for use in R using the Intel compiler?
When I take out the mexFunction subroutine and try compiling the rest of the code, I get the following error:
D:\SS_Programming\Fortran>R CMD SHLIB Zhang_4.f90
c:/Rtools/mingw_64/bin/gfortran -O2 -mtune=core2 -c Zhang_4.f90 -o
Zhang_4.o
Zhang_4.f90:6.4:
use ifwin
1
Fatal Error: Can't open module file 'ifwin.mod' for reading at (1): No
such file or directory
make: *** [Zhang_4.o] Error 1
Warning message:
running command 'make -f "C:/PROGRA~1/R/R-34~1.2/etc/x64/Makeconf" -f
"C:/PROGRA~1/R/R-34~1.2/share/make/winshlib.mk"
SHLIB_LDFLAGS='$(SHLIB_FCLDFLAGS)' SHLIB_LD='$(SHLIB_FCLD)'
SHLIB="Zhang_4.dll" SHLIB_LIBADD='$(FCLIBS)' WIN=64 TCLBIN=64
OBJECTS="Zhang_4.o"' had status 2
I don't think there is any other way then rewrite the code to not use IFWIN. Unless you manage to use Intel Fortran for R (that might require recompiling the whole R distribution...). Matlab is tied to Intel Fortran, that's why the code worked there.
You have to adjust the code anyway, you cannot use it as it stands.
Just get rid of the AllocConsole() calls and the print statements. You will need to use the R routines to print to console. See https://cran.r-project.org/doc/manuals/R-exts.html#Printing-from-FORTRAN
In Fortran 90, I want to numerically integrate a mathematical function with one variable within a given limit. For example, integrating f(x) = x**2 from 0 to 10. The function I have is more complicated than this one and I have to run it several times changing the integration limits. I found out on internet that the 'QUADPACK' library might help me with this. But how can I install this library so that I can call this in my code? Provide some details as I won't be able to follow advanced instructions quickly.
I've provided a simple program where midpoint method is used to integrate x^2. A more complicated formula may be entered, so long the mesh is fine enough (and the function is smooth), this should work..
program integrate
implicit none
integer,parameter :: cp = selected_real_kind(14)
integer,parameter :: N = 1000
real(cp),dimension(N) :: f,xc
real(cp),dimension(N+1) :: x
real(cp) :: s,xmax,xmin,dx
integer :: i
xmin = 0.0_cp
xmax = 10.0_cp
dx = (xmax - xmin)/real(N,cp)
x = (/(xmin + dx*(i-1),i=1,N+1)/)
! Define x at center
do i=1,N
xc(i) = x(i) + 0.5_cp*dx
enddo
! Define f
do i=1,N
f(i) = xc(i)**2
enddo
! Integrate (Midpoint method)
s = 0.0_cp
do i=1,N
s = s + f(i)*dx
enddo
write(*,*) 'sum = ',s
end program
Here is one possible solution to integrate your function f(x) = x**2 from 0 to 10. This uses the Gaussian quadrature formula for 8 and 16 points.
program quadrature
implicit none
! Declare variables
integer, parameter :: n8 = 8, n16 = 16
real(8) :: r, m, c
real(8) :: a, b, result8, result16
real(8), dimension (n8) :: x8, w8
real(8), dimension(n16) :: x16, w16
integer :: i
! Define the limits of integration
a = 0.D0
b = 10.D0
! Define the abscissas and weights for 8-point Gauss quadrature
data x8 /-0.1834346424956498D0, 0.1834346424956498D0, -0.5255324099163290D0, 0.5255324099163290D0, &
-0.7966664774136267D0, 0.7966664774136267D0, -0.9602898564975363D0, 0.9602898564975363D0/
data w8 / 0.3626837833783620D0, 0.3626837833783620D0, 0.3137066458778873D0, 0.3137066458778873D0, &
0.2223810344533745D0, 0.2223810344533745D0, 0.1012285362903763D0, 0.1012285362903763D0/
! Define the abscissas and weights for 16-point Gauss quadrature
data x16 /-0.0950125098376374D0, 0.0950125098376374D0, -0.2816035507792589D0, 0.2816035507792589D0, &
-0.4580167776572274D0, 0.4580167776572274D0, -0.6178762444026438D0, 0.6178762444026438D0, &
-0.7554044083550030D0, 0.7554044083550030D0, -0.8656312023878318D0, 0.8656312023878318D0, &
-0.9445750230732326D0, 0.9445750230732326D0, -0.9894009349916499D0, 0.9894009349916499D0 /
data w16 /0.1894506104550685D0, 0.1894506104550685D0, 0.1826034150449236D0, 0.1826034150449236D0, &
0.1691565193950025D0, 0.1691565193950025D0, 0.1495959888165767D0, 0.1495959888165767D0, &
0.1246289712555339D0, 0.1246289712555339D0, 0.0951585116824928D0, 0.0951585116824928D0, &
0.0622535239386479D0, 0.0622535239386479D0, 0.0271524594117541D0, 0.0271524594117541D0 /
! Compute the results using 8-point and 16-point Gauss quadrature
r = 0.D0
m = (b-a)/2.D0
c = (b+a)/2.D0
result8 = 0.D0
result16 = 0.D0
do i = 1, n8
result8 = result8 + w8(i) * f(m*x8(i) + c)
end do
result8 = result8*m
do i = 1, n16
result16 = result16 + w16(i) * f(m*x16(i) + c)
end do
result16 = result16*m
! Print the results
print *, "Result using 8-point Gauss quadrature: ", result8
print *, "Result using 16-point Gauss quadrature: ", result16
contains
! Function to be integrated
real(8) function f(x)
real(8), intent(in) :: x
f = x**2.D0
end function
end program
I'm trying to write a Fortran subroutine that does some matrix multiplication. I use R to create the inputs:
set.seed(7232015)
#############
# meta data #
#############
B <- 200 # (actually millions)
D <- 100 # number of markov chain monte carlo draws (actually 4,000)
T <- 8 # number of quarters
#########
# input #
#########
input <- data.frame(
treat = sample(0:1, B, T), # treatment indicator
time = sample(1:T, B, T), # time
weight = rnorm(B), # weight
pred = rnorm(B), # predictions (x \hat\beta)
eresid = exp(rnorm(B))
) # exp(resid) exp(y - x \hat\beta)
thetaTime <- matrix(rnorm(T * D), T, D) # time-by-treatment intrxn
theta <-
thetaTime[input$time,] # pull off the relevant value for ea obs
rm(list=setdiff(ls(), c("input", "theta", "T")))
And I have an R function that does what I need:
test2 <- function(d, DF, theta, T){
D <- ncol(theta)
B <- nrow(DF)
DF$epredC <- exp(DF$pred + theta[,d] * (DF$treat == 1))
DF$epredT <- exp(DF$pred - theta[,d] * (DF$treat == 0))
DF$diff <-
as.vector(
DF$eresid %*% matrix(
DF$epredT, nrow = B, ncol = B, byrow = T
)
)
return(DF$diff)
}
x <- test2(d = 1, DF = input, theta = theta, T = T)
The Fortran subroutine should create exaclty the vector x of size 200 in this example.
This is the fortran code I wrote:
subroutine test3(d, i, nMCd, DF, theta, C)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,5) :: DF
double precision, intent(in), dimension(i,nMCd) :: theta
double precision, dimension(i) :: epredC, epredT
double precision, intent(out), dimension(i) :: C
C=0.0d0
epredC = exp(DF(:,4) + (theta(:,d) * DF(:,1)))
epredT = exp(DF(:,4) + (theta(:,d) * (1-DF(:,1))))
do jj=1, i
do j=1, i
C(jj) = C(jj) + DF(j,5)*epredT(jj)
end do
end do
end subroutine test3
I am able to compile it and run it on R
system("R CMD SHLIB ./Fortran/mytest.f90")
dyn.load("./Fortran/mytest.so")
X <- .Fortran("test3", d = as.integer(1), i = nrow(input),
nMCd = nrow(theta), DF = unlist(input),
theta = unlist(theta),
C = numeric(nrow(input)))
But in R x[1]=415.937 and in Fortran X$C[1]=10414.94
What am I doing wrong? Thanks!
I know my do loop is wrong, but I cannot figure out why...
If I change my fortran subroutine to this, it works as it should
subroutine test5(d, i, nMCd, DF, theta, C)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,5) :: DF
double precision, intent(in), dimension(i,nMCd) :: theta
double precision, dimension(i) :: epredC, epredT
double precision, intent(out), dimension(i) :: C
double precision, dimension(i,i) :: B
C=0.0d0
B=0.0d0
epredC = exp(DF(:,4) + (theta(:,d) * DF(:,1)))
epredT = exp(DF(:,4) + (theta(:,d) * (1-DF(:,1))))
do j=1,i
B(:,j)=epredT(j)
end do
C = matmul(DF(:,5), B)
end subroutine test5
Is this method or the loop more efficient in Fortran?
My first Fortran lesson is to plot the probability density function of the radial Sturmian functions. In case you are interested, the radial Sturmian functions are used to graph the momentum space eigenfunctions for the hydrogen atom.
In order to produce these radial functions, one needs to first produce some polynomials called the Gegenbauer polynomials, denoted
Cba(x),
where a and b should be stacked atop each other. One needs these polynomials because the Sturmians (let's call them R_n,l) are defined like so,
R_n,l(p) = N pl⁄(p2 + k2)l+2 Cn - l - 1l + 1(p2 - k2⁄p2 + k2),
where N is a normalisation constant, p is the momentum, n is the principle quantum number, l is the angular momentum and k is a constant. The normalisation constant is there so that when I come to square this function, it will produce a probability distribution for the momentum of the electron in a hydrogen atom.
Gegenbauer polynomials are generated using the following recurrence relation:
Cnl(x) = 1⁄n[2(l + n - 1) x Cn - 1l(x) - (2l + n - 2)Cn - 2l(x)],
with C0l(x) = 1 and C1l(x) = 2lx, as you may have noticed, l is fixed but n is not. At the start of my program, I will specify both l and n and work out the Gegenbauer polynomial I need for the radial function I wish to plot.
The problems I am having with my code at the moment are all in my subroutine for working out the value of the Gegenbauer polynomial Cn-l-1l+1(p2 - k2⁄p2 + k2) for incremental values of p between 0 and 3. I keep getting the error
Unclassified statement at (1)
but I cannot see what the issue is.
program Radial_Plot
implicit none
real, parameter :: pi = 4*atan(1.0)
integer, parameter :: top = 1000, l = 50, n = 100
real, dimension(1:top) :: x, y
real increment
real :: a=0.0, b = 2.5, k = 0.3
integer :: i
real, dimension(1:top) :: C
increment = (b-a)/(real(top)-1)
x(1) = 0.0
do i = 2, top
x(i) = x(i-1) + increment
end do
Call Gegenbauer(top, n, l, k, C)
y = x*C
! y is the function that I shall be plotting between values a and b.
end program Radial_Plot
Subroutine Gegenbauer(top1, n1, l1, k1, CSub)
! This subroutine is my attempt to calculate the Gegenbauer polynomials evaluated at a certain number of values between c and d.
implicit none
integer :: top1, i, j, n1, l1
real :: k1, increment1, c, d
real, dimension(1:top1) :: x1
real, dimension(1:n1 - l1, 1:top1) :: C1
real, dimension(1:n1 - l1) :: CSub
c = 0.0
d = 3.0
k1 = 0.3
n1 = 50
l1 = 25
top1 = 1000
increment1 = (d - c)/(real(top1) - 1)
x1(1) = 0.0
do i = 2, top1
x1(i) = x1(i-1) + increment1
end do
do j = 1, top1
C1(1,j) = 1
C1(2,j) = 2(l1 + 1)(x1(i)^2 - k1^2)/(x1(i)^2 + k1^2)
! All the errors occurring here are all due to, and I quote, 'Unclassifiable statement at (1)', I can't see what the heck I have done wrong.
do i = 3, n1 - l1
C1(i,j) = 2(((l1 + 1)/n1) + 1)(x1(i)^2 - k1^2)/(x1(i)^2 + k1^2)C1(i,j-1) - ((2(l1+1)/n1) + 1)C1(i,j-2)
end do
CSub(j) = Cn(n1 - l1,j)^2
end do
return
end Subroutine Gegenbauer
As francesalus correctly pointed out, the problem is because you use ^ instead of ** for exponentiation. Additionally, you do not put * between the terms you are multiplying.
C1(1,j) = 1
C1(2,j) = 2*(l1 + 1)*(x1(i)**2 - k1**2)/(x1(i)**2 + k1**2)
do i = 3, n1 - l1
C1(i,j) = 2 * (((l1 + 1)/n1) + 1) * (x1(i)**2 - k1**2) / &
(x1(i)**2 + k1**2)*C1(i,j-1) - ((2(l1+1)/n1) + 1) * &
C1(i,j-2)
end do
CSub(j) = Cn(n1 - l1,j)**2
Since you are beginning I have some advice. Learn to put all subroutines and functions to modules (unless they are internal). There is no reason for the return statement at the and of the subroutine, similarly as a stop statement isn't necessary at the and of the program.