I've just started coding in a physics class at my university, so I'm pretty new to all of this. However, I can't find where I'm going wrong on this one:
! Purpose: Assignment #2
! Author: Rourke Sekelsky
! Date: 9/7/2015
program arith
implicit none ! Turn off implicit typing
real :: x,y ! Define variables
real, parameter :: pi = 3.14159 ! Set the parameter pi
write(*,*) "Enter x:" ! Prompt user to enter their x-value
read(*,*) x ! Read in x-value
y = (3.0*x)+(6.0*pi)((x**3+x**(7.0/2.0)))+11.0/3.0
! Determine value of function at given x-value
write(*,*) " f(x) = ",y ! Write out the function value
stop ! Stop execution of program
end program arith
EDIT: I'm getting an unclassifiable statement error at the "y = " part. This program won't compile with gfortran, and I'm not sure what's wrong. Some help would be nice, thank you!
One-character typo. You left out the * operator between your multiplicands. y = (3.0*x)+(6.0*pi)*((x**3.0+x**(7.0/2.0)))+11.0/3.0 works.
Related
this is the program. and I got an error why?
''''code'''''
I don't know why the whole doesn't appear, I tried to determine the area and volume for a random number.
----------------why-------------
'''Fortran
'program exercise2'
!
integer :: N,i
type :: Values
double precision :: radius,area,volume
end type
!
!
type(Values),allocatable, dimension(:) :: s
integer :: bi
!
!Read the data to create the random number
write(6,*) 'write your number '
read(5,*) N
allocate(s(N))
bi = 3.14
!create the random number
call random_seed()
do i=1,N
call random_number(s(i)%radius)
s(i)%area=areacircle(s(i)%radius)
s(i)%volume=volumesphere(s(i)%radius)
end do
!
open(15,file='radius.out',status='new')
write(15,*) s(i)%radius
open(16,file='output2.out',status='new')
r = real(s(i)%radius)
!Two function
contains
double precision function areacircle (s)
implicit none
double precision :: s
do i=1 , N
areacircle=bi*r**2
end do
return
end function areacircle
!
!
double precision function volumesphere (s)
implicit none
double precision :: s
do i=1,N
volumesphere=4/3*bi*r**3
end do
return
write(16,*) r , areacircle , volumesphere
end function volumesphere
'end program exercise2'
'''''''
so anyone know why?
This likely does what you want. As the computation of area and volume involve a single input that does not change, I've changed your functions to be elemental. This allows an array argument where the function is executed for each element of the array. I also changed double precision to use Fortran kind type parameter mechanism, because typing is real(dp) is much shorter.
Finally, never write a Fortran program without the implicit none statement.
program exercise2
implicit none ! Never write a program without this statement
integer, parameter :: dp = kind(1.d0) ! kind type parameter
integer n, i
type values
real(dp) radius, area, volume
end type
type(values), allocatable :: s(:)
real(dp) bi ! integer :: bi?
! Read the data to create the random number
write(6,*) 'write your number '
read(5,*) n
! Validate n is validate.
if (n < 1) stop 'Invalid number'
allocate(s(n))
bi = 4 * atan(1.d0) ! bi = 3.14? correctly determine pi
call random_seed() ! Use default seeding
call random_number(s%radius) ! Fill radii with random numbers
s%area = areacircle(s%radius) ! Compute area
s%volume = volumesphere(s%radius) ! Compute volume
write(*,'(A)') ' Radii Area Volume'
do i = 1, n
write(*, '(3F9.5)') s(i)
end do
contains
elemental function areacircle(s) result(area)
real(dp) area
real(dp), intent(in) :: s
area = bi * s**2
end function areacircle
elemental function volumesphere(s) result(volume)
real(dp) volume
real(dp), intent(in) :: s
volume = (4 * bi / 3) * s**3
end function volumesphere
end program exercise2
everyone.
I am just playing with the calculation of integral of x^2 from [1, 2] using both midpoint rule and Simpson's rule. And I find it out that with the same number of subintervals midpoint rule approximation seems more accurate than Simpson's rule approximation, which is really weird.
The source code of midpoint rule approximation is :
program midpoint
implicit none ! Turn off implicit typing
Integer, parameter :: n=100 ! Number of subintervals
integer :: i ! Loop index
real :: xlow=1.0, xhi=2.0 ! Bounds of integral
real :: dx ! Variable to hold width of subinterval
real :: sum ! Variable to hold sum
real :: xi ! Variable to hold location of ith subinterval
real :: fi ! Variable to value of function at ith subinterval
dx = (xhi-xlow)/(1.0*n) ! Calculate with of subinterval
sum = 0.0 ! Initialize sum
xi = xlow+0.5*dx ! Initialize value of xi
do i = 1,n,1 ! Initiate loop
! xi = xlow+(0.5+1.0*i)*dx
write(*,*) "i,xi ",i,xi ! Print intermidiate result
fi = xi**2 ! Evaluate function at ith point
sum = sum+fi*dx ! Accumulate sum
xi = xi+dx ! Increment location of ith point
end do ! Terminate loop
write(*,*) "sum =",sum
stop ! Stop execution of the program
end program midpoint
the according execution is:
...... ..... ..................
i,xi 100 1.99499905
sum = 2.33332348
The source code of Simpson's rule approximation is:
program simpson
implicit none ! Turn off implicit typing
integer, parameter :: n=100 ! Number of subintervals
integer :: i=0 ! Loop index
real :: xlow=1.0, xhi=2.0 ! Bounds of integral
real :: h ! Variable to hold width of subinterval
real :: sum ! Variable to hold sum
real :: xi ! Variable to hold location of ith subinterval
real :: fi ! Variable to value of function at ith subinterval
real :: Psimp ! Variable of simpson polynomial of xi interval
h = (xhi-xlow)/(1.0*n) ! Calculate width of subinterval
sum = 0.0 ! Initialize sum
do while (xi<=xhi-h) ! Initiate loop
xi = xlow+i*2.0*h ! Increment of xi
i=i+1
write(*,*) "i,xi ",i,xi ! Print intermidiate result
Psimp=xi**2+4.0*(xi+h)**2+(xi+2.0*h)**2
! Evaluate function at ith point
sum = sum+(h/3.0)*Psimp ! Accumulate sum
end do ! Terminate loop
write(*,*) "sum =",sum
end program simpson
the according execution is:
........ ...... ...................
i,xi 101 2.00000000
sum = 2.37353396
To get the same precision of digits as midpoint result, I have to set the number of subintervals in Simpson's program to 100000, which is 1000 times more than the midpoint program (I initially set both of the number subintervals to 100)
I check the codes in Simpson's program and can't find whats wrong.
Simpson's rule should converge more rapid than midpoint rule if I remembered it correct.
Craig Burley once remarked that a WHILE loop looked like as soon as the premise of the loop was violated, the loop would be exited immediately. Here the premise of the loop is violated when x=xhi but the loop doesn't break at that point, only when a whole nother iteration is completed and the test can be applied at the top of the loop. You could more consistently with Fortran idioms convert the loop into a counted DO loop with something like
DO i = 0, n/2-1
and then comment out the
i=i+1
line. Or simply test the loop premise immediately after modifying xi:
xi = xlow+i*2.0*h ! Increment of xi
if(xi>xhi-h) exit ! Test loop premise
Either way leads to the exact results expected for a polynomial of degree no higher than 3 for Simpson's rule.
I am writing a program that uses a given subroutine to calculate spherical Bessel functions. I modified the subroutine which gives a table into a function which only gives one value. However, I realized that when I call my function I need to have IMPLICIT DOUBLE PRECISION (A-H,O-Z) in my program or it will give me a wrong value or error. Below I have included a sample program that works correctly.
! n = 3, x = 2 should return ~ 6.07E-2
program hello
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
doubleprecision :: bessel, ans
WRITE(*,*)'Please enter n and x '
READ(*,*)N,X
ans = bessel(N,X)
print *, ans
end program
SUBROUTINE SPHJ(N,X,NM,SJ,DJ)
! =======================================================
! Purpose: Compute spherical Bessel functions jn(x) and
! their derivatives
! Input : x --- Argument of jn(x)
! n --- Order of jn(x) ( n = 0,1,??? )
! Output: SJ(n) --- jn(x)
! DJ(n) --- jn'(x)
! NM --- Highest order computed
! Routines called:
! MSTA1 and MSTA2 for computing the starting
! point for backward recurrence
! =======================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION SJ(0:N),DJ(0:N)
NM=N
IF (DABS(X).EQ.1.0D-100) THEN
DO 10 K=0,N
SJ(K)=0.0D0
10 DJ(K)=0.0D0
SJ(0)=1.0D0
DJ(1)=.3333333333333333D0
RETURN
ENDIF
SJ(0)=DSIN(X)/X
SJ(1)=(SJ(0)-DCOS(X))/X
IF (N.GE.2) THEN
SA=SJ(0)
SB=SJ(1)
M=MSTA1(X,200)
IF (M.LT.N) THEN
NM=M
ELSE
M=MSTA2(X,N,15)
ENDIF
F0=0.0D0
F1=1.0D0-100
DO 15 K=M,0,-1
F=(2.0D0*K+3.0D0)*F1/X-F0
IF (K.LE.NM) SJ(K)=F
F0=F1
15 F1=F
IF (DABS(SA).GT.DABS(SB)) CS=SA/F
IF (DABS(SA).LE.DABS(SB)) CS=SB/F0
DO 20 K=0,NM
20 SJ(K)=CS*SJ(K)
ENDIF
DJ(0)=(DCOS(X)-DSIN(X)/X)/X
DO 25 K=1,NM
25 DJ(K)=SJ(K-1)-(K+1.0D0)*SJ(K)/X
RETURN
END
INTEGER FUNCTION MSTA1(X,MP)
! ===================================================
! Purpose: Determine the starting point for backward
! recurrence such that the magnitude of
! Jn(x) at that point is about 10^(-MP)
! Input : x --- Argument of Jn(x)
! MP --- Value of magnitude
! Output: MSTA1 --- Starting point
! ===================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
A0=DABS(X)
N0=INT(1.1*A0)+1
F0=ENVJ(N0,A0)-MP
N1=N0+5
F1=ENVJ(N1,A0)-MP
DO 10 IT=1,20
NN=N1-(N1-N0)/(1.0D0-F0/F1)
F=ENVJ(NN,A0)-MP
IF(ABS(NN-N1).LT.1) GO TO 20
N0=N1
F0=F1
N1=NN
10 F1=F
20 MSTA1=NN
RETURN
END
INTEGER FUNCTION MSTA2(X,N,MP)
! ===================================================
! Purpose: Determine the starting point for backward
! recurrence such that all Jn(x) has MP
! significant digits
! Input : x --- Argument of Jn(x)
! n --- Order of Jn(x)
! MP --- Significant digit
! Output: MSTA2 --- Starting point
! ===================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
A0=DABS(X)
HMP=0.5D0*MP
EJN=ENVJ(N,A0)
IF (EJN.LE.HMP) THEN
OBJ=MP
N0=INT(1.1*A0)
ELSE
OBJ=HMP+EJN
N0=N
ENDIF
F0=ENVJ(N0,A0)-OBJ
N1=N0+5
F1=ENVJ(N1,A0)-OBJ
DO 10 IT=1,20
NN=N1-(N1-N0)/(1.0D0-F0/F1)
F=ENVJ(NN,A0)-OBJ
IF (ABS(NN-N1).LT.1) GO TO 20
N0=N1
F0=F1
N1=NN
10 F1=F
20 MSTA2=NN+10
RETURN
END
REAL*8 FUNCTION ENVJ(N,X)
DOUBLE PRECISION X
ENVJ=0.5D0*DLOG10(6.28D0*N)-N*DLOG10(1.36D0*X/N)
RETURN
END
!end of file msphj.f90
doubleprecision function bessel(N,X)
implicit doubleprecision(A-Z)
DIMENSION SJ(0:250),DJ(0:250)
integer :: N
CALL SPHJ(N,X,N,SJ,DJ)
bessel = SJ(N)
end function
And here is a sample program that does not work, using the same function.
program hello
IMPLICIT none
doubleprecision :: bessel, ans
integer :: N, X
WRITE(*,*)'Please enter n and x '
READ(*,*)N,X
ans = bessel(N,X)
print *, ans
end program
I am relatively new to Fortran and don't understand why my program doesn't work. I appreciate any help that anyone can provide.
I guess the non working sample program uses the same implementation of bessel as the working sample.
If so, there is a conflict of type between the the type of N and X (integer in the non working main program) and the corresponding arguments in bessel which are all double precision per the specification
implicit doubleprecision(A-Z)
Everything in bessel is by default doubleprecision. Your main program must define N and X as doubleprecision.
The best solution as I said in the comment above is to use explicit typing everywhere.
I am trying to write a programme to calculate an absorption band model for seismic waves. The whole calculation is based on 3 equations. If interested, see equations 3, 4, 5 on p.2 here:
http://www.eri.u-tokyo.ac.jp/people/takeuchi/publications/14EPSL-Iritani.pdf
However, I have debugged this programme several times now but I do not seem to get the expected answer. I am specifically trying to calculate Q_1 variable (seismic attenuation) in the following programme, which should be a REAL positive value on the order of 10^-3. However, I am getting negative values. I need a fresh pair of eyes to take a look at the programme and to check where I have done a mistake if any. Could someone please check? Many thanks !
PROGRAM absorp
! Calculate an absorption band model and output
! files for plotting.
! Ref. Iritani et al. (2014), EPSL, 405, 231-243.
! Variable Definition
! Corners - cf1, cf2
! Frequency range - [10^f_strt, 10^(f_end-f_strt)]
! Number of points to be sampled - n
! Angular frequency - w
! Frequency dependent Attenuation 1/Q - Q_1
! Relaxation times - tau1=1/(2*pi*cf1), tau2=1/(2*pi*cf2)
! Reference velocity - V0 (km/s)
! Attenuation (1/Q) at 1 Hz - Q1_1
! Frequency dependent peak Attenuation (1/Qm) - Qm_1
! Frequency dependent velocity - V_w
! D(omega) numerator - Dw1
! D(omega) denominator - Dw2
! D(omega) - D_w
! D(2pi) - D_2pi
IMPLICIT NONE
REAL :: cf1 = 2.0e0, cf2 = 1.0e+5
REAL, PARAMETER :: f_strt=-5, f_end=12
INTEGER :: indx
INTEGER, PARAMETER :: n=1e3
REAL, PARAMETER :: pi=4.0*atan(1.0)
REAL, DIMENSION(1:n) :: w, Q_1
REAL :: tau1, tau2, V0, freq, pow
REAL :: Q1_1=0.003, Qm_1
COMPLEX, DIMENSION(1:n) :: V_w
COMPLEX, PARAMETER :: i=(0.0,1.0)
COMPLEX :: D_2pi, D_w, Dw1, Dw2
! Reference Velocity km/s
V0 = 12.0
print *, "F1=", cf1, "F2=", cf2, "V0=",V0
! Relaxation times from corners
tau1 = 1.0/(2.0*pi*cf1)
tau2 = 1.0/(2.0*pi*cf2)
PRINT*, "tau1=",tau1, "tau2=",tau2
! Populate angular frequency array (non-linear)
DO indx = 1,n+1
pow = f_strt + f_end*REAL(indx-1)/n
freq=10**pow
w(indx) = 2*pi*freq
print *, w(indx)
END DO
! D(2pi) value
D_2pi = LOG((i*2.0*pi + 1/tau1)/(i*2.0*pi + 1/tau2))
! Calculate 1/Q from eq. 3 and 4
DO indx=1,n
!D(omega)
Dw1 = (i*w(indx) + 1.0/tau1)
Dw2 = (i*w(indx) + 1.0/tau2)
D_w = LOG(Dw1/Dw2)
!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/ &
((Q1_1**2-4)*IMAG(D_w)**2 &
+ 4*Q1_1*IMAG(D_w)*REAL(D_w))
!This is eq. 3 for Alpha(omega)
V_w(indx) = V0*(SQRT(1.0 + 2.0/pi*Qm_1*D_w)/ &
REAL(SQRT(1.0 + 2.0/pi*Qm_1*D_2pi)))
!This is eq. 4 for 1/Q
Q_1(indx) = 2*IMAG(V_w(indx))/REAL(V_w(indx))
PRINT *, w(indx)/(2.0*pi), (V_w(indx)), Q_1(indx)
END DO
! write the results out
100 FORMAT(F12.3,3X,F7.3,3X,F8.5)
OPEN(UNIT=1, FILE='absorp.txt', STATUS='replace')
DO indx=1,n
WRITE(UNIT=1,FMT=100), w(indx)/(2.0*pi), REAL(V_w(indx)), Q_1(indx)
END DO
CLOSE(UNIT=1)
END PROGRAM
More of an extended comment with formatting than an answer ...
I haven't checked the equations you refer to, and I'm not going to, but looking at your code makes me suspect misplaced brackets as a likely cause of errors. The code, certainly as you've shown it here, isn't well formatted to reveal its logical structure. Whatever you do next invest in some indents and some longer lines to avoid breaking too frequently.
Personally I'm suspicious in particular of
!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/ &
((Q1_1**2-4)*IMAG(D_w)**2 &
+ 4*Q1_1*IMAG(D_w)*REAL(D_w))
I'm using a subroutine to output an array gathered from a previous function. After running my program and only calling the subroutine once, my intended file name, testf.txt, is given as "testf.txtÑ #." Thinking it was a hidden character generated by a portion I borrowed from a friend, I retyped the whole section but nothing changed. When I do multiple calls, the names of the the files add onto one another. Intended, "testf.txt" "testg.txt" "testh.txt", given, "testf.txttestg" "testg.txttesth" and "testh.txt". The content is fine, the name being the only issue. Would that be caused by hidden characters in the code, or a logic error in how the subroutine hold information?
Thanks,
Thomas
Main Program
program Main
implicit none
!DATA DICTIONARY
character :: selection ! Method of summation
! L = left Riemann sum
! R = right Riemann sum
! M = Midpoint rule
! T = Trapezoidal rule sum
! S = Simpson's rule
integer :: n ! Number of subintervals the integral is to
! be divided into
integer :: func ! The function to be integrated
! f = (28.0/5) + 2*sin(4*x) - (1/x)
! g = ln(4x) + (19x)^3 - 43
! h = 1/(sqrt(2.0*PI))*exp(-(x**2)/2.0)
character(20) :: filename
real, external :: f
real, external :: g
real, external :: h
real, dimension(1000) :: area
!Declare functions used
real :: Quad
write(*,*) "Written in the form ",
+ "Quad(func, n, left, right, selection):"
write(*,*) " "
!Test Drivers
write(*, *) Quad(f, 10, 0.2, 3.2, 'T', area)
call Out(10, area, 'testf.txt')
write(*, *) Quad(g, 10, 5.0, 10.0, 'L', area)
call Out(10, area, 'testg.txt')
write(*, *) Quad(h, 25, 1.0, 10.0, 'L', area)
call Out(10, area, 'testh.txt')
end program Main
Actual Out subroutine
subroutine Out(n, area, filename)
!PRE: n > 0
! area is the initialized array area(1...n)
! filename is initialized
implicit none
integer, intent(in) :: n
real, dimension(n), intent(in) :: area
character(20), intent(in) :: filename
integer :: i
open(unit=1, file=filename, form='formatted', !Writes area(1...n) to a file
+ action='write', status='replace')
do i = 1, n, 1
write(1,*) area(i)
end do
close(unit=1)
end subroutine Out
This sort of error is normally an indication of one or more of:
Array overruns - i.e. if your data is in an array of size 10 followed by your filen ame in memory and you write to array element 11 it will corrupt the file name.
Array under run - similar to the above but at the start of the array
Parameter corruption - if the text for the file name is passed as a read write parameter then it can be overwritten in the code.
You can often sort out this sort of issue by a) turn on all compiler error checking and fix all the warnings and/or b running the code through a lint equivalent such as ftnchek and fixing the issues it finds.