So far my code is working properly except I am now getting a compiler error error like this:
std =std +((x(I) -xbar))**2)
1
Error: Unclassifiable statement at (1)
Here is my code:
program cardata
implicit none
real, dimension(291) :: x
intEGER I,N
double precision date, odometer, fuel
real :: std=0
real :: xbar=0
open(unit=10, file="car.dat", FOrm="FORMATTED", STATUS="OLD", ACTION="READ")
read(10,*) N
do I=1,N
read(10,*) x(I)
xbar= xbar +x(I)
enddo
xbar = xbar/N
DO I =1,N
std =std +((x(I) -xbar))**2
enddo
std = SQRT((std / (N - 1)))
print*,'mean:',xbar
print*, 'std deviation:',std
close(unit=10)
end program cardata
I am fairly new to this, any input will be greatly appreciated.
Count the parentheses.
std =std +((x(I) -xbar))**2)
There are three of these: (
There are four of these: )
Since this is likely a course I will help you how to debug.
Basically start with some write statements... Check your answers...
program cardata
implicit none
...
read(10,*) N
WRITE(*,*)' I read N as ',N
WRITE(*,*)'XBar starts as ', Xbar
do I=1,N
...
! was XBAr ever set to start at 0!
xbar= xbar +x(I)
...
WRITE(*,*)'Syd starts as ',Std
DO I =1,N
std =std +((x(I) -xbar))**2
enddo
WRITE(*,*)'Std starts is now ',Std,' and n =',N
! What do we do if N=1 or is Std is negative?
WRITE(*,*)'SQRT(Std)=', SQRT(Std)
std = SQRT((std / (N - 1)))
...
At some point You will determine that X is a column, and it is the first column. What is the second column? Y?
Related
The task is to write the code for calculating integral of the polynomial function. the function id displayed in the image I attached. I wrote the code and it compiled and the answer came out. However, it is completely different with the analytical solution. The code:
program rectangularApproximation
write(*,*) "Input values of a ,b and eps"
read(*,*) a,b,eps
1 continue
n=1000
h=(b-a)/n
s=0.0
do i=1,n
x=a+h*i
s=s+f(x)*h
enddo
sprev=s
n=10*n
h=(b-a)/n
s=0.0
do i=1,n
x=a+h*i
s=s+f(x)*h
enddo
snext=s
if (abs(sprev-snext)<eps) then
write(*,*) snext,n
stop
end if
goto 1
write(*,*) s
end
real function f(x)
implicit none
real, intent(in) :: x
integer :: i
real, dimension(8) :: numbers
numbers = (/1,3,1,4,2,3,0,1 /)
do i = 1,8
f = f + numbers(i) * x**(numbers(i))
end do
end function
The result obtained by running the code is 588189248 (the interval (a,b) is (1,2) and i chose epsillon=0.001) Analytical solution is following :
The answer of analytical solution is 169.256 . What could have gone wrong in my code?
Your polynomial code is wrong:
do i = 1,8
f = f + numbers(i) * x**(numbers(i))
end do
That should be
do i = 1,8
f = f + numbers(i) * x**i
end do
Even though I do not exactly know why, it seems that Fortran (90) does not allow do loops inside where blocks. A code structured as follows does not compile with gfortran (Unexpected DO statement in WHERE block at (1)):
real :: a(30), b(30,10,5)
integer :: i, j
do i=1,10
where(a(:) > 0.)
! do lots of calculations
! modify a
do j=1,5
b(:,i,j)=...
enddo
endwhere
enddo
The only workaround that I can think of would be
real :: a2(30)
do i=1,10
a2(:)=a(:)
where(a(:) > 0.)
! do lots of calculations
! modify a
endwhere
do j=1,5
where(a2(:) > 0.)
b(:,i,j)=...
endwhere
enddo
enddo
I suppose that there are more elegant solutions? Especially if the where condition is less straightforward, this will look messy pretty soon... Thanks!
If your arrays are all 1-indexed, you can replace where constructs by explicitly storing and using array masks, for example
program test
implicit none
real :: a(30), b(30,10,5)
integer :: i, j
integer, allocatable :: mask(:)
do i=1,10
mask = filter(a(:)>0.)
! do lots of calculations
! modify a
do j=1,5
b(mask,i,j)=...
enddo
enddo
contains
! Returns the array of indices `i` for which `input(i)` is `true`.
function filter(input) result(output)
logical, intent(in) :: input(:)
integer, allocatable :: output(:)
integer :: i
output = pack([(i,i=1,size(input))], mask=input)
end function
end program
Program Main
implicit none
include 'mpif.h'
!Define parameters
integer::my_rank,p2,n2,ierr,source
integer, parameter :: n=3,m=3,o=m*n
real(kind=8) aaa(n),ddd(n),bbb(n),ccc(n),xxx(n),b(m,n),start, finish
integer i, j
real h
real(kind=8),dimension(:),allocatable::sol1
h=0.25
b=0
do i=1,m
b(i,i)=1/(1.2**i)
b(i,i-1)=-b(i,i)
enddo
call MPI_INIT(ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,p2,ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,my_rank,ierr)
allocate(sol1(o))
start=MPI_WTIME()
do i=1,n
aaa(i)=-1/h**2
bbb(i)=2/h**2+b(my_rank+1,my_rank+1)
ccc(i)=-1/h**2
ddd(i)=1/h**2
enddo
call thomas(aaa,bbb,ccc,ddd,xxx,n)
finish=MPI_WTIME()
print*, finish-start
write(*,*) xxx, my_rank
call MPI_GATHER(xxx,n, MPI_REAL, sol1,n,MPI_REAL8,0, MPI_COMM_WORLD,ierr)
print*,sol1
call MPI_FINALIZE(ierr)
end program main
subroutine thomas(ld,md,ud,rh,solution,n)
implicit none
integer,parameter :: r8 = kind(1.d0)
integer,intent(in) :: n
real(r8),dimension(n),intent(in) :: ld,md,ud,rh
real(r8),dimension(n),intent(out) :: solution
real(r8),dimension(n) :: P,Q
real(r8) :: m
integer i
P(1) = ud(1)/md(1)
Q(1) = rh(1)/md(1)
do i = 2,n
m = md(i)-p(i-1)*ld(i)
P(i) = ud(i)/m
Q(i) = (rh(i)-Q(i-1)*ld(i))/m
end do
solution(n) = Q(n)
do i = n-1, 1, -1
solution(i) = Q(i)-P(i)*solution(i+1)
end do
end subroutine thomas
Here I used MPI_WTIME() to find the execution time. It seems like when I increase the number of processor than I am not getting the speedup. In this code I have m=3 (I make m equal equal to no of processor). I run with mpirun -np 3 sp.exe). Now I change say m=10 and run with mpirun -np 10 sp.exe. I should get the less time, isn't it? or I am missing something here. The community helped me before with some issues and now I am getting another issue. I would really appreciate the help if somebody would point out something.Isn't the chunk of code starting with do loop done by invidual processors( which I want)?
my program display no error but it can't work?
program hw4
dimension a(i,j)
real a
common i,j
integer i,j
do i=1,4,1
do j=1,5,1
a(1,1)=0
a(1,2)=1
a(1,3)=2
a(1,4)=3
a(1,5)=25
a(2,1)=1
a(2,2)=1
a(2,3)=1
a(2,4)=1
a(2,5)=12
a(3,1)=2
a(3,2)=0
a(3,3)=3
a(3,4)=1
a(3,5)=19
a(4,1)=3
a(4,2)=4
a(4,3)=0
a(4,4)=6
a(4,5)=41
write(*,*) a(i,j)
enddo
enddo
stop
end
I expect it will show 4*5 matrix,but now it will show me the program stop work message
Firstly, your matrix "a" must have constant shape i.e. dimensions "i" and "j" must be explicitly defined.
Secondly, your nested loop sets matrix values every loop. Try putting it before the loop.
Something like:
program hw4
implicit none
integer, parameter :: ni=4, nj=5
real, dimension(ni,nj) :: a
integer :: i, j
! Set matrix values here
a(1,1) = 0
! ...
do i = 1, ni, 1
do j = 1, nj, 1
write(*,*) a(i,j)
end do
end do
end program hw4
Kind regards
so reading the following question (Correct use of FORTRAN INTENT() for large arrays) I learned that defining a variable with intent(in) isn't enough, since when the variable is passed to another subroutine/function, it can be changed again. So how can I avoid this? In the original thread they talked about putting the subroutine into a module, but that doesn't help for me. For example I want to calculate the determinant of a matrix with a LU-factorization. Therefore I use the Lapack function zgetrf, but however this function alters my input matrix and the compiler don't displays any warnings. So what can I do?
module matHelper
implicit none
contains
subroutine initMat(AA)
real*8 :: u
double complex, dimension(:,:), intent(inout) :: AA
integer :: row, col, counter
counter = 1
do row=1,size(AA,1)
do col=1,size(AA,2)
AA(row,col)=cmplx(counter ,0)
counter=counter+1
end do
end do
end subroutine initMat
!subroutine to write a Matrix to file
!Input: AA - double complex matrix
! fid - integer file id
! fname - file name
! stat - integer status =replace[0] or old[1]
subroutine writeMat(AA,fid, fname, stat)
integer :: fid, stat
character(len=*) :: fname
double complex, dimension(:,:), intent(in) :: AA
integer :: row, col
character (len=64) :: fmtString
!opening file with given options
if(fid /= 0) then
if(stat == 0) then
open(unit=fid, file=fname, status='replace', &
action='write')
else if(stat ==1) then
open(unit=fid, file=fname, status='old', &
action='write')
else
print*, 'Error while trying to open file with Id', fid
return
end if
end if
!initializing matrix print format
write(fmtString,'(I0)') size(aa,2)
fmtString = '('// trim(fmtString) //'("{",ES10.3, ",", 1X, ES10.3,"}",:,1X))'
!write(*,*) fmtString
!writing matrix to file by iterating through each row
do row=1,size(aa,1)
write(fid,fmt = fmtString) AA(row,:)
enddo
write(fid,*) ''
end subroutine writeMat
!function to calculate the determinant of the input
!Input: AA - double complex matrix
!Output determinantMat - double complex,
! 0 if AA not a square matrix
function determinantMat(AA)
double complex, dimension(:,:), intent(in) :: AA
double complex :: determinantMat
integer, dimension(min(size(AA,1),size(AA,2)))&
:: ipiv
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU facotirzation with LAPACK function
call zgetrf(size(AA,1),size(AA,2), AA,size(AA,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA(ii,ii)
end if
end do
end function determinantMat
end module matHelper
!***********************************************************************
!module which stores matrix elements, dimension, trace, determinant
program test
use matHelper
implicit none
double complex, dimension(:,:), allocatable :: AA, BB
integer :: n, fid
fid = 0;
allocate(AA(3,3))
call initMat(AA)
call writeMat(AA,0,' ', 0)
print*, 'Determinante: ',determinantMat(AA) !changes AA
call writeMat(AA,0, ' ', 0)
end program test
PS: I am using the ifort compiler v15.0.3 20150407
I do not have ifort at home, but you may want to try compiling with '-check interfaces' and maybe with '-ipo'. You may need the path to 'zgetrf' for the '-check interfaces' to work, and if that is not source then it may not help.
If you declare 'function determinantMat' as 'PURE FUNCTION determinantMat' then I am pretty sure it would complain because 'zgetrf' is not known to be PURE nor ELEMENTAL. Try ^this stuff^ first.
If LAPACK has a module, then zgetrf could be known to be, or not be, PURE/ELEMENTAL. https://software.intel.com/en-us/articles/blas-and-lapack-fortran95-mod-files
I would suggest you add to your compile line:
-check interfaces -ipo
During initial build I like (Take it out for speed once it works):
-check all -warn all
Making a temporary array is one way around it. (I have not compiled this, so it is only a conceptual exemplar.)
PURE FUNCTION determinantMat(AA)
USE LAPACK95 !--New Line--!
IMPLICIT NONE !--New Line--!
double complex, dimension(:,:) , intent(IN ) :: AA
double complex :: determinantMat !<- output
!--internals--
integer, dimension(min(size(AA,1),size(AA,2))) :: ipiv
!!--Next line is new--
double complex, dimension(size(AA,1),size(AA,2)) :: AA_Temp !!<- I have no idea if this will work, you may need an allocatable??
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU factorization with LAPACK function
!!--Next line is new--
AA_Temp = AA !--Initialise AA_Temp to be the same as AA--!
call zgetrf(size(AA_temp,1),size(AA_Temp,2), AA_Temp,size(AA_Temp,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA_Temp,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA_Temp(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA_Temp(ii,ii)
end if
end do
end function determinantMat
With the 'USE LAPACK95' you probably do not need PURE, but if you wanted it to be PURE then you want to explicitly say so.