How to write result data in array from this fortran code - fortran

I can get data from this code, but need to acquire them in array for plotting surface plot. So, I try get 101X101 based on the below the code, the data which i want to write is data(i,j).
program test
implicit none
! --- [local entities]
real*8 :: rrr,th,U0,amp,alp,Ndiv
real*8 :: pi,alpR,NR,Rmin,Rmax,z, data(101:101)
integer :: ir, i, j
OPEN(UNIT=10, FORM='unformatted', FILE="data")
do i=1, 101
do j=1, 101
th=atan2(real(i-51,kind(0d0)),real(j-51,kind(0d0)))
pi=atan(1.d0)*4.d0
!
Ndiv= 24.d0 !! Number of circumferential division
alp = 90.d0/180.d0*pi !! phase [rad]
U0 = 11.4d0 !! average velocity
amp = 0.5d0 !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6.d0 !! Number of radial division
!
rrr=sqrt(real(i-51,kind(0d0))**2+real(j-51,kind(0d0))**2)
ir=int((rrr-Rmin)/(Rmax-Rmin)*NR)
alpR=2.d0*pi/dble(Ndiv)*dble(mod(ir,2))
data(i,j)=U0*(1.d0+amp*dsin(0.5d0*Ndiv*th+alp+alpR))
write(10) data(i,j)
end do
end do
stop
end program test
but there are some error, I couldn't figure out how to solve it.
test.f90:27.10:
data(i,j)=z
1
Error: Rank mismatch in array reference at (1) (2/1)
test.f90:28.20:
write(10) data(i,j)
1
Error: Rank mismatch in array reference at (1) (2/1)
klogin7$ gfortran test.f90
test.f90:27.10:
data(i,j)=z
1
Error: Rank mismatch in array reference at (1) (2/1)
test.f90:28.20:
write(10) data(i,j)
1
Error: Rank mismatch in array reference at (1) (2/1)

Related

MPI fortran 90 - Abort errors on nodes during execution

I am trying to execute this program using MPI that I have written in fortran:
Program CartesianGrid2D
Implicit None
Include 'mpif.h'
!----------------------------------------!
! Setting of the computational grid !
Integer, Parameter :: NDIM = 2 ! number of space dimensions
Integer, Parameter :: IMAX = 200 ! number of grid points in x-direction
Integer, Parameter :: JMAX = 200 ! number of grid points in y-direction
Real, Parameter :: x0=0.0 !min x-coord
Real, Parameter :: x1=1.0 !max x-coord
Real, Parameter :: y0=0.0 !min y-coord
Real, Parameter :: y1=1.0 !max y-coord
!----------------------------------------!
! Local variable declaration
TYPE tMPI
Integer :: myrank
Integer :: nCPU
Integer :: status(MPI_STATUS_SIZE)
Integer :: iStart, iEnd !idx of starting and ending cell in x-dir
Integer :: jStart, jEnd !idx of starting and ending cell in y-dir
Integer :: imax, jmax !number of cells within each rank
Integer, Allocatable :: mycoords(:) !point coords of the subgrid
Integer :: iErr !flag for errors in x-dir
Integer :: x_thread !number of CPUs in x-dir
Integer :: y_thread !number of CPUs in y-dir
End TYPE tMPI
TYPE(tMPI) :: MPI
Logical, Allocatable :: periods(:)
Integer, Allocatable :: dims(:)
Integer :: TCPU, BCPU, RCPU, LCPU !neighbor ranks of myrank
Integer :: i, j, idx, jdx, source
Integer :: COMM_CART !cartesian MPI communicator
Real :: dx, dy
Real, Allocatable :: x(:), y(:) ! grid coordinates
!----------------------------------------!
! 1) MPI initialization
CALL MPI_INIT(MPI%iErr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, MPI%myrank, MPI%iErr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,MPI%nCPU,MPI%iErr)
! check the number of CPUs
If(MOD(MPI%nCPU,2).ne.0) then
print *, 'ERROR. Number of CPU must be even!'
CALL MPI_FINALIZE(MPI%iErr)
Stop
End if
CALL MPI_BARRIER(MPI_COMM_WORLD,MPI%iErr)
! 2) Create a Cartesian topology
! check the number of cells
If(MOD(IMAX,2).ne.0) then
print *, 'ERROR. Number of x-cells must be even!'
CALL MPI_FINALIZE(MPI%iErr)
Stop
End if
If(MOD(JMAX,2).ne.0) then
print *, 'ERROR. Number of y-cells must be even!'
CALL MPI_FINALIZE(MPI%iErr)
Stop
End if
! Domain decomposition
MPI%x_thread = MPI%nCPU/2
MPI%y_thread = MPI%nCPU - MPI%x_thread
Allocate(dims(NDIM), periods(NDIM), MPI%mycoords(NDIM))
dims = (/ MPI%x_thread, MPI%y_thread /)
periods = .FALSE.
CALL MPI_CART_CREATE(MPI_COMM_WORLD,NDIM,dims,periods,.TRUE.,COMM_CART,MPI%iErr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, MPI%myrank, MPI%iErr)
! 2.3) Find CPU neighbords
CALL MPI_CART_SHIFT(COMM_CART,0,1,source,RCPU,MPI%iErr)
CALL MPI_CART_SHIFT(COMM_CART,0,-1,source,LCPU,MPI%iErr)
CALL MPI_CART_SHIFT(COMM_CART,1,0,source,TCPU,MPI%iErr)
CALL MPI_CART_SHIFT(COMM_CART,-1,0,source,BCPU,MPI%iErr)
! coordinates of the subgrid
CALL MPI_CART_COORDS(COMM_CART,MPI%myrank,NDIM,MPI%mycoords,MPI%iErr)
MPI%imax = IMAX/MPI%x_thread
MPI%jmax = JMAX/MPI%y_thread
MPI%iStart = 1 + MPI%mycoords(1)*MPI%imax
MPI%iEnd = MPI%iStart + MPI%imax - 1
MPI%jStart = 1 + MPI%mycoords(2)*MPI%jmax
MPI%jEnd = MPI%jStart + MPI%jmax - 1
! 3) Comoute the real mesh
dx = (x1-x0)/Real(IMAX-1)
dy = (y1-y0)/Real(JMAX-1)
Allocate(x(MPI%IMAX))
Allocate(y(MPI%JMAX))
idx = 0
Do i = MPI%iStart, MPI%iEnd
idx = idx + 1
x(idx) = (x0-dx/2.) + (i-1)*dx
End do
jdx = 0
Do i = MPI%jStart, MPI%jEnd
jdx = jdx + 1
y(jdx) = (y0-dy/2.) + (j-1)*dy
End do
! 4) Plot the output and finalize the program
CALL ASCII_Output(x,y,MPI%imax,MPI%jmax,MPI%myrank)
CALL MPI_FINALIZE(MPI%iErr)
End program CartesianGrid2D
Subroutine ASCII_Output(x,y,imax,jmax,myrank)
!-----------------------------------------!
Implicit None
!-----------------------------------------!
Integer :: imax, jmax, myrank
Real :: x(imax), y(jmax)
Integer :: i, j, DataUnit
Character(len=10) :: cmyrank
Character(len=200) :: IOFileName
!-----------------------------------------!
Write(cmyrank,'(I4.4)') myrank
IOFileName = 'CartesianGrid_output-'//TRIM(cmyrank)//'.dat'
DataUnit = 100+myrank
Open(Unit=DataUnit, File=Trim(IOFileName), Status='Unknown', Action='Write')
Write(DataUnit,*) imax
Write(DataUnit,*) jmax
Do i = 1, imax
Write(DataUnit,*) x(i)
End do
Do j = 1, jmax
Write(DataUnit,*) y(j)
End do
Close(DataUnit)
End Subroutine ASCII_Output
However whenever I try to execute I have got this list of errors popping up:
Abort(795947788) on node 0 (rank 0 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x60000384c9f0, periods=0x60000384c9e0, reorder=1, comm_cart=0x16f8532a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
Abort(863056652) on node 1 (rank 1 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x600003030760, periods=0x600003030860, reorder=1, comm_cart=0x16ef332a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
Abort(460403468) on node 2 (rank 2 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x6000039647d0, periods=0x6000039647e0, reorder=1, comm_cart=0x16d05f2a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
Abort(191968012) on node 3 (rank 3 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x600000b78470, periods=0x600000b784e0, reorder=1, comm_cart=0x16f75f2a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
Abort(997274380) on node 4 (rank 4 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x6000039843e0, periods=0x6000039843d0, reorder=1, comm_cart=0x16ba532a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
Abort(259076876) on node 5 (rank 5 in comm 0): Fatal error in internal_Cart_create: Invalid argument, error stack:
internal_Cart_create(102): MPI_Cart_create(MPI_COMM_WORLD, ndims=2, dims=0x6000016cab90, periods=0x6000016caaa0, reorder=1, comm_cart=0x16d3232a0) failed
MPIR_Cart_create_impl(43): Size of the communicator (6) is smaller than the size of the Cartesian topology (9)
What I first do is : mpif90 -cpp -lmpi NameOfTheProgram.f90 and then whenever I execute the a.out I do mpirun -np 6 ./a.out
Running this on a MacBook Air M1 (Whenever I have to run fortran I usually use a gfortran compiler).
Your computation
MPI%x_thread = MPI%nCPU/2
MPI%y_thread = MPI%nCPU - MPI%x_thread
makes no sense. As the error message indicates, the product of x_thread and y_thread is not equal to your communicator size.
Please use MPI_Dims_create to set these parameters.

Fortran Error: Rank mismatch in array reference (2/1) [duplicate]

I kindly request your help on this code where I kept on getting
an error: Rank mismatch in array reference at (1) (2/1). My objective is to go through each point in a cube(p = i+(j-1)*N + (k-1)NN) and calculate the gradient of the potential along each axis (gradphi_x, gradphi_y, gradphi_z).
PROGRAM sub_rho_phi
integer, parameter:: N=3
real, dimension(N):: gradphi_x, gradphi_y, gradphi_z
call output(gradphi_x, gradphi_y, gradphi_z)
open(unit=1,file="grad_phi.dat")
l = 0
do
l=l+1
write(1,*) gradphi_x(l),gradphi_y(l),gradphi_z(l)
if ( l == N**3) then
exit
end if
end do
END
SUBROUTINE output( gradphi_x, gradphi_y, gradphi_z )
real, parameter:: h=0.7,G=6.67,M=1.98892*(10**3)!!in(10**15) kg
integer, parameter:: N=3
real, dimension(N):: r, gradphi_x,gradphi_y,gradphi_z
integer, dimension(N**3):: x,y,z
integer:: p
real:: a
a=500/h !in kpc
do i=0, N
do j=0, N
do k=0, N
p = i+(j-1)*N + (k-1)*N*N
x(p,1)=i
y(p,2)=j
z(p,3)=k
r(p)=sqrt(x(p,1)*x(p,1)+y(p,2)*y(p,2)+z(p,3)*z(p,3))
gradphi_x(p)=(G*M)*x(p,1)/r(p)*(r(p)+a)**2
gradphi_y(p)=(G*M)*y(p,2)/r(p)*(r(p)+a)**2
gradphi_z(p)=(G*M)*z(p,3)/r(p)*(r(p)+a)**2
enddo
enddo
enddo
return
END
You have declared x, y and z as one dimensional arrays, but are using two dimensional indexing all the way through output.

'x' argument of 'log10' intrinsic at (1) must be real [duplicate]

I want to calculate z value as the coordinate in range of x:-50~50 and y:-50~50 like below code.
program test
implicit none
! --- [local entities]
real*8 :: rrr,th,U0,amp,alp,Ndiv
real*8 :: pi,alpR,NR,Rmin,Rmax,z
integer :: ir, i, j
do i=0, 50
do j=0, 50
th=datan2(i,j)
pi=datan(1.d0)*4.d0
!
Ndiv= 24.d0 !! Number of circumferential division
alp = 90.d0/180.d0*pi !! phase [rad]
U0 = 11.4d0 !! average velocity
amp = 0.5d0 !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6.d0 !! Number of radial division
!
rrr=dsqrt(i**2+j**2)
ir=int((rrr-Rmin)/(Rmax-Rmin)*NR)
alpR=2.d0*pi/dble(Ndiv)*dble(mod(ir,2))
z=U0*(1.d0+amp*dsin(0.5d0*Ndiv*th+alp+alpR))
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
But I couldn't make it work like below error. I think because i, j are in datan(i,j). How should I change these code?
test.f90:10.16:
th=datan2(i,j)
1
Error: 'y' argument of 'datan2' intrinsic at (1) must be REAL
test.f90:21.16:
rrr=dsqrt(i**2+j**2)
1
Error: 'x' argument of 'dsqrt' intrinsic at (1) must be REAL
Inspired by the comments of #Rodrigo Rodrigues, #Ian Bush, and #Richard, here is a suggested rewrite of the code segment from #SW. Kim
program test
use, intrinsic :: iso_fortran_env, only : real64
implicit none
! --- [local entities]
! Determine the kind of your real variables (select one):
! for specifying a given numerical precision
integer, parameter :: wp = selected_real_kind(15, 307) !15 digits, 10**307 range
! for specifying a given number of bits
! integer, parameter :: wp = real64
real(kind=wp), parameter :: pi = atan(1._wp)*4._wp
real(kind=wp) :: rrr, th, U0, amp, alp, Ndiv
real(kind=wp) :: alpR, NR, Rmin, Rmax, z
integer :: ir, i, j
do i = 0, 50
do j = 0, 50
th = atan2(real(i, kind=wp), real(j, kind=wp))
!
Ndiv= 24._wp !! Number of circumferential division
alp = 90._wp/180._wp*pi !! phase [rad]
U0 = 11.4_wp !! average velocity
amp = 0.5_wp !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6._wp !! Number of radial division
!
rrr = sqrt(real(i, kind=wp)**2 + real(j, kind=wp)**2)
ir = int((rrr - Rmin) / (Rmax - Rmin) * NR)
alpR = 2._wp * pi / Ndiv * mod(ir, 2)
z = U0 * (1._wp + amp * sin(0.5_wp * Ndiv * th + alp + alpR))
!
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
Specifically, the following changes were made with respect to the original code posted:
Minimum change to answer the question: casting integer variables i and j to real values for using them in the real valued functions datan and dsqrt.
Using generic names for intrinsic procedures, i.e sqrt instead of dsqrt, atan instead of datan, and sin instead of dsin. One benefit of this approach, is that the kind of working precision wp can be changed in one place, without requiring explicit changes elsewhere in the code.
Defining the kind of real variables and calling it wp. Extended discussion of this topic, its implications and consequences can be found on this site, for example here and here. Also #Steve Lionel has an in depth post on his blog, where his general advice is to use selected_real_kind.
Defining pi as a parameter calculating its value once, instead of calculating the same value repeatedly within the nested for loops.

Fortran Error: 'y' argument of 'datan2' intrinsic at (1) must be REAL

I want to calculate z value as the coordinate in range of x:-50~50 and y:-50~50 like below code.
program test
implicit none
! --- [local entities]
real*8 :: rrr,th,U0,amp,alp,Ndiv
real*8 :: pi,alpR,NR,Rmin,Rmax,z
integer :: ir, i, j
do i=0, 50
do j=0, 50
th=datan2(i,j)
pi=datan(1.d0)*4.d0
!
Ndiv= 24.d0 !! Number of circumferential division
alp = 90.d0/180.d0*pi !! phase [rad]
U0 = 11.4d0 !! average velocity
amp = 0.5d0 !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6.d0 !! Number of radial division
!
rrr=dsqrt(i**2+j**2)
ir=int((rrr-Rmin)/(Rmax-Rmin)*NR)
alpR=2.d0*pi/dble(Ndiv)*dble(mod(ir,2))
z=U0*(1.d0+amp*dsin(0.5d0*Ndiv*th+alp+alpR))
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
But I couldn't make it work like below error. I think because i, j are in datan(i,j). How should I change these code?
test.f90:10.16:
th=datan2(i,j)
1
Error: 'y' argument of 'datan2' intrinsic at (1) must be REAL
test.f90:21.16:
rrr=dsqrt(i**2+j**2)
1
Error: 'x' argument of 'dsqrt' intrinsic at (1) must be REAL
Inspired by the comments of #Rodrigo Rodrigues, #Ian Bush, and #Richard, here is a suggested rewrite of the code segment from #SW. Kim
program test
use, intrinsic :: iso_fortran_env, only : real64
implicit none
! --- [local entities]
! Determine the kind of your real variables (select one):
! for specifying a given numerical precision
integer, parameter :: wp = selected_real_kind(15, 307) !15 digits, 10**307 range
! for specifying a given number of bits
! integer, parameter :: wp = real64
real(kind=wp), parameter :: pi = atan(1._wp)*4._wp
real(kind=wp) :: rrr, th, U0, amp, alp, Ndiv
real(kind=wp) :: alpR, NR, Rmin, Rmax, z
integer :: ir, i, j
do i = 0, 50
do j = 0, 50
th = atan2(real(i, kind=wp), real(j, kind=wp))
!
Ndiv= 24._wp !! Number of circumferential division
alp = 90._wp/180._wp*pi !! phase [rad]
U0 = 11.4_wp !! average velocity
amp = 0.5_wp !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6._wp !! Number of radial division
!
rrr = sqrt(real(i, kind=wp)**2 + real(j, kind=wp)**2)
ir = int((rrr - Rmin) / (Rmax - Rmin) * NR)
alpR = 2._wp * pi / Ndiv * mod(ir, 2)
z = U0 * (1._wp + amp * sin(0.5_wp * Ndiv * th + alp + alpR))
!
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
Specifically, the following changes were made with respect to the original code posted:
Minimum change to answer the question: casting integer variables i and j to real values for using them in the real valued functions datan and dsqrt.
Using generic names for intrinsic procedures, i.e sqrt instead of dsqrt, atan instead of datan, and sin instead of dsin. One benefit of this approach, is that the kind of working precision wp can be changed in one place, without requiring explicit changes elsewhere in the code.
Defining the kind of real variables and calling it wp. Extended discussion of this topic, its implications and consequences can be found on this site, for example here and here. Also #Steve Lionel has an in depth post on his blog, where his general advice is to use selected_real_kind.
Defining pi as a parameter calculating its value once, instead of calculating the same value repeatedly within the nested for loops.

Cannot call a function from the same scope

I'm confused about the scope. I downloaded a Fortran file which has 1 main program, 1 subroutine and 1 function in 1 source file. The main program does not contain the subprograms, and the function is called by the subroutine. It works fine, but when I modified the main program to contain those 2 subprograms using "contains", it gives compile error, saying the function is not defined. However, if I create a small function within the same contained section and call from the subroutine, it does not give an error.
What is the difference between those 2 functions? Why do I get the error?
I created a small program with the same structure, 1 main that contains a subroutine and a func and it did not give an error.
My environment is ubuntu 14.04 and using gfortran compiler.
Building target: QRbasic
Invoking: GNU Fortran Linker
gfortran -o "QRbasic" ./main.o
./main.o: In function qrbasic':
/*/QRbasic/Debug/../main.f95:79: undefined reference toajnorm_'
/home/kenji/workspace/QRbasic/Debug/../main.f95:104: undefined reference to `ajnorm_'
collect2: error: ld returned 1 exit status
make: *** [QRbasic] Error 1
Program Main
!====================================================================
! QR basic method to find the eigenvalues
! of matrix A
!====================================================================
implicit none
integer, parameter :: n=3
double precision, parameter:: eps=1.0e-07
double precision :: a(n,n), e(n)
integer i, j, iter
! matrix A
! data (a(1,i), i=1,3) / 8.0, -2.0, -2.0 /
! data (a(2,i), i=1,3) / -2.0, 4.0, -2.0 /
! data (a(3,i), i=1,3) / -2.0, -2.0, 13.0 /
data (a(1,i), i=1,3) / 1.0, 2.0, 3.0 /
data (a(2,i), i=1,3) / 2.0, 2.0, -2.0 /
data (a(3,i), i=1,3) / 3.0, -2.0, 4.0 /
! print a header and the original matrix
write (*,200)
do i=1,n
write (*,201) (a(i,j),j=1,n)
end do
! print: guess vector x(i)
! write (*,204)
! write (*,201) (y(i),i=1,3)
call QRbasic(a,e,eps,n,iter)
! print solutions
write (*,202)
write (*,201) (e(i),i=1,n)
write (*,205) iter
200 format (' QR basic method - eigenvalues for A(n,n)',/, &
' Matrix A')
201 format (6f12.6)
202 format (/,' The eigenvalues')
205 format (/,' iterations = ',i5)
!end program main
contains
subroutine QRbasic(a,e,eps,n,iter)
!==============================================================
! Compute all eigenvalues: real symmetric matrix a(n,n,)
! a*x = lambda*x
! method: the basic QR method
! Alex G. (January 2010)
!--------------------------------------------------------------
! input ...
! a(n,n) - array of coefficients for matrix A
! n - dimension
! eps - convergence tolerance
! output ...
! e(n) - eigenvalues
! iter - number of iterations to achieve the tolerance
! comments ...
! kmax - max number of allowed iterations
!==============================================================
implicit none
integer n, iter
double precision a(n,n), e(n), eps
double precision q(n,n), r(n,n), w(n), an, Ajnorm, sum, e0,e1
integer k, i, j, m
integer, parameter::kmax=1000
! initialization
q = 0.0
r = 0.0
e0 = 0.0
do k=1,kmax ! iterations
! step 1: compute Q(n,n) and R(n,n)
! column 1
an = Ajnorm(a,n,1)
r(1,1) = an
do i=1,n
q(i,1) = a(i,1)/an
end do
! columns 2,...,n
do j=2,n
w = 0.0
do m=1,j-1
! product q^T*a result = scalar
sum = 0.0
do i=1,n
sum = sum + q(i,m)*a(i,j)
end do
r(m,j) = sum
! product (q^T*a)*q result = vector w(n)
do i=1,n
w(i) = w(i) + sum*q(i,m)
end do
end do
! new a'(j)
do i =1,n
a(i,j) = a(i,j) - w(i)
end do
! evaluate the norm for a'(j)
an = Ajnorm(a,n,j)
r(j,j) = an
! vector q(j)
do i=1,n
q(i,j) = a(i,j)/an
end do
end do
! step 2: compute A=R(n,n)*Q(n,n)
a = matmul(r,q)
! egenvalues and the average eigenvale
sum = 0.0
do i=1,n
e(i) = a(i,i)
sum = sum+e(i)*e(i)
end do
e1 = sqrt(sum)
! print here eigenvalues
! write (*,201) (e(i),i=1,n)
!201 format (6f12.6)
! check for convergence
if (abs(e1-e0) < eps) exit
! prepare for the next iteration
e0 = e1
end do
iter = k
if(k == kmax) write (*,*)'The eigenvlue failed to converge'
print *, func1()
end subroutine QRbasic
function Ajnorm(a,n,j)
implicit none
integer n, j, i
double precision a(n,n), Ajnorm
double precision sum
sum = 0.0
do i=1,n
sum = sum + a(i,j)*a(i,j)
end do
Ajnorm = sqrt(sum)
end function Ajnorm
integer function func1()
print *, "dummy"
func1=1
end function
end program
The original program did not contain those 2 programs. This is the version I get an error.
Your main program contains a declaration of the type of function Ajnorm(). As a result, when the compiler finds that name to be used as a function name, it interprets it as an external function. That's quite correct in the original form of the program, with the function defined as an independent unit, but it is wrong for an internal (contained) function. Your program compiles cleanly for me once I remove the unneeded declaration.