I'm very new to Fortran and have to simulate the Rutherford Scattering experiment for an assignment. In the code, there is a gold nucleus assumed to be at the center (x,y) = (0,0). I'm trying to find the acceleration, velocity and then distance of the alpha particle based on the Coloumb's Law. r_lim is meant to be the boundary condition which, when the particle passes, the loop is meant to stop successfully. Please let me know if I can explain anything else.
PROGRAM rutherford_scatter
IMPLICIT NONE
TYPE particle
REAL:: x,y
END TYPE particle
TYPE(particle):: r_alpha, v_alpha, a_alpha
REAL:: x_0,y_0, v_0, q_gold, q_alpha, k_e, m_alpha, c, c_frac, time_step, r_lim
LOGICAL :: check = .FALSE.
k_e = 1.0
c = 137.053999
time_step = 1.0 *10.0**(-5.0)
q_alpha = 2.0
q_gold = 79.0
m_alpha = 7294.3
WRITE (*,*) 'Enter initial value for x distance.'
READ (*,*) x_0
y_0 = -0.005
WRITE (*,*) 'Enter initial value for velocity (fraction of speed of light).'
READ (*,*) c_frac
v_0 = c_frac * c
r_alpha%x = x_0
r_alpha%y = y_0
r_lim = 1.1 * SQRT(r_alpha%x**2+r_alpha%y**2)
v_alpha%x = 0
v_alpha%y = ABS(v_0)
OPEN (11, FILE = 'assign_11.out')
DO WHILE (check)
a_alpha = acceleration(k_e, m_alpha, q_gold, q_alpha, r_alpha)
v_alpha = velocity (v_alpha, a_alpha)
r_alpha = distance (r_alpha, v_alpha)
WRITE (11,*) r_alpha
IF (r_alpha%x .GT. r_lim .OR. r_alpha%y .GT. r_lim) THEN
check =.TRUE.
END IF
END DO
CLOSE(11)
CONTAINS
TYPE (particle) FUNCTION acceleration (k_e, m_alpha, q_gold, q_alpha,r_alpha)
TYPE (particle), INTENT(IN):: r_alpha
REAL, INTENT (IN)::k_e, m_alpha, q_gold, q_alpha
acceleration%x = (k_e/m_alpha) * ((q_gold * q_alpha)/(ABS(r_alpha%x))**2 )* (r_alpha%x/SQRT(r_alpha%x**2+r_alpha%y**2))
acceleration%y = (k_e/m_alpha) * ((q_gold * q_alpha)/(ABS(r_alpha%y))**2 )*(r_alpha%y/SQRT(r_alpha%x**2+r_alpha%y**2))
END FUNCTION
TYPE (particle) FUNCTION velocity (v_alpha, a_alpha)
TYPE (particle), INTENT (IN):: a_alpha, v_alpha
velocity%x = v_alpha%x + a_alpha%x*time_step
velocity%y = v_alpha%y + a_alpha%y* time_step
END FUNCTION
TYPE(particle) FUNCTION distance (r_alpha, v_alpha)
TYPE (particle), INTENT (IN):: r_alpha, v_alpha
distance%x = r_alpha%x + v_alpha%x * time_step
distance%y = r_alpha%y + v_alpha%y * time_step
END FUNCTION
END PROGRAM rutherford_scatter
Related
I am trying to simulate harmonic oscillator by using Verlet Method(Original Verlet) in Fortran.
My research tells that the order of error should be 2 but my calculation showed the order of 1.
I couldn't find my mistake in my source code. What should I do?
Edit:
The algorithm I am using is below:
x(t+Δt) = 2x(t) - x(t-Δt) + Δt² F(t)/m
v(t) = {x(t+Δt) -x(t-Δt)}/2Δt
Where x(t) represents the position, v(t) represents velocity and F(t) represents Force. I recognize this is the Original Verlet described here
According to this site, the order of error should be at least O(Δt²) but the error of the order of my program plotted in gnuplot (below) does not have a order of O(Δt²).
program newton_verlet
implicit none
real*16, parameter :: DT = 3.0
real*16, parameter :: T0 = 0.0
real*16, parameter :: TEND = 2.0
integer, parameter :: NT = int(TEND/DT + 0.5)
real*16, parameter :: M = 1.0
real*16, parameter :: X0 = 1.0
real*16, parameter :: V0 = 0.0
real*16 x,v,t,xold,xnew,vnew,ek,ep,et,f,h
integer it,n
do n=0,20
h = DT/2**n
x = X0
v = V0
ek = 0.5*M*v*v
ep = x*x/2
et = ek + ep
xold = x - v*h
do it = 1,2**n
! f = -x
f = -x
xnew = 2.0*x - xold + f*h*h/M
v = (xnew-xold)/(2.0*h)
ek = 0.5*M*v*v
ep = 0.5*xnew*xnew
et = ek + ep
xold = x
x = xnew
end do
write(*,*) h,abs(x-cos(DT))+abs(v+sin(DT))
end do
end program
Above program calculates the error of calculation for the time step h.
According to the Wiki page for Verlet integrators, it seems that we need to use a more accurate way of setting the initial value of xold (i.e., include terms up to the force) to get the global error of order 2. Indeed, if we modify xold as
program newton_verlet
implicit none
real*16, parameter :: DT = 3.0
real*16, parameter :: M = 1.0
real*16, parameter :: X0 = 1.0
real*16, parameter :: V0 = 0.0
real*16 x,v,xold,xnew,f,h
integer it,n
do n = 0, 20
h = DT / 2**n
x = X0
v = V0
f = -x
! xold = x - v * h !! original
xold = x - v * h + f * h**2 / (2 * M) !! modified
do it = 1, 2**n
f = -x
xnew = 2 * x - xold + f * h * h / M
xold = x
x = xnew
end do
write(*,*) log10( h ), log10( abs(x - cos(DT)) )
end do
end program
the global error becomes of order 2 (please see the log-log plot below).
I've written a program that successfully shows a simple limit cycle for the Duffing equation. However, I now need to plot the Poincaré section for this case.
I need to do this by taking snapshots of the Phase-Space diagram at regular time intervals, such that t*omega = 2*pi*n. As I have omega set to 1 for this case, this is just when t = 2*pi*n. I've attempted this, but am not getting the Poincaré section I expect.
Here's my code:
program rungekutta
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
integer :: i, n
real(kind=dp) z, y, t, A, C, D, B, omega, h
open(unit=100, file="rungekutta.dat",status='replace')
n = 0
!constants
omega = 1.0_dp
A = 0.25_dp
B = 1.0_dp
C = 0.1_dp
D = 1.0_dp
y = 0.0_dp
z = 0.0_dp
t = 0.0_dp
do i=1,1000
call rk2(z, y, t, n)
n = n + 1.0_dp
write(100,*) y, z
end do
contains
subroutine rk2(z, y, t, n) !subroutine to implement runge-kutta algorithm
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
integer, intent(inout) :: n
real(kind=dp) :: k1y, k1z, k2y, k2z, y, z, t, pi
pi = 4.0*ATAN(1.0)
h = 0.1_dp
t = n*2*pi
k1y = dydt(y,z,t)*h
k1z = dzdt(y,z,t)*h
k2z = dzdt(y + (0.5_dp*k1y), z + (0.5_dp*k1z), t + (0.5_dp*h))*h
k2y = dydt(y, z +(0.5_dp*k1z), t)*h
y = y + k2y
z = z + k2z
end subroutine
!2nd order ODE split into 2 for coupled Runge-Kutta, useful to define 2
functions
function dzdt(y,z,t)
real(kind=dp) :: y, z, t, dzdt
dzdt = -A*y**3.0_dp + B*y - C*z + D*sin(omega*t)
end function
function dydt(y,z,t)
real(kind=dp) :: z, dydt, y, t
dydt = z
end function
end program
I have also attached an image of what my Poincaré section looks like:
.
This is y on the x axis vs dydt.
And an image of what I'd expect:
In your rk2 routine you perform one step of step length 0.1. Thus the plot is the full trajectory of the solution at that resolution. However the intend seems to be to integrate over a full period length. This would require a loop in that routine.
In other words, what you want is the plot of (y(n*T), z(n*T)) where T is one of the periods of the system, per your code T=2*p. What you actually compute is (y(n*h), z(n*h)) where h=0.1 is the step size of a single step of RK2.
Also the arguments of k2y need to be corrected as per the comment of user5713492
With a corrected integrator you should get something like the following picture:
where the red squares are the points at t=n*2*pi. The indicated step size by the dots on the solution curve is the same h=0.1, the integration is over t=0..300.
def RK2(f,u,times,subdiv = 1):
uout = np.zeros((len(times),)+u.shape)
uout[0] = u;
for k in range(len(times)-1):
t = times[k]
h = (times[k+1]-times[k])/subdiv
for j in range(subdiv):
k1 = f(u,t)*h
k2 = f(u+0.5*k1, t+0.5*h)*h
u, t = u+k2, t+h
uout[k+1]=u
return uout
def plotphase(A,B,C,D):
def derivs(u,t): y,z = u; return np.array([ z, -A*y**3 + B*y - C*z + D*np.sin(t) ])
N=60
u0 = np.array([0.0, 0.0])
t = np.arange(0,300,2*np.pi/N);
u = RK2(derivs, u0, t, subdiv = 10)
plt.plot(u[:-2*N,0],u[:-2*N,1],'.--y', u[-2*N:,0],u[-2*N:,1], '.-b', lw=0.5, ms=2);
plt.plot(u[::N,0],u[::N,1],'rs', ms=4); plt.grid(); plt.show()
plotphase(0.25, 1.0, 0.1, 1.0)
For some reason it never interpolates, but it gives 0 as an answer. The code is:
PROGRAM LAGRANGE
REAL X(0:100), Y(0:100), INTERP
REAL TEMP = 1.0
REAL POLINOM = 0.0
N=10
OPEN(1,FILE="datos.txt")
DO I=0,100 !We 'clean' the arrays: all positions are 0
X(I)=0.0
Y(I)=0.0
END DO
DO I=0,10 !We read the data file and we save the info
READ(1,*) X(I), Y(I)
END DO
CLOSE(1)
WRITE(*,*) "Data table:"
DO I=0,10
WRITE(*,*) X(I), Y(I)
END DO
WRITE(*,*) "Which value of X do you want to interpolate?"
READ(*,*) INTERP
DO I=0,N
DO J=0,N
IF(J.NE.I) THEN !Condition: J and I can't be equal
TEMP=TEMP*(INTERP-X(J))/(X(I)-X(J))
ELSE IF(J==I) THEN
TEMP=TEMP*1.0
ELSE
END IF
END DO
POLINOM=POLINOM+TEMP
END DO
WRITE(*,*) "Value: ",POLINOM
STOP
END PROGRAM
Where did I fail? I basically need to implement this:
Lagrange interpolation method
Thanks a lot in advance.
In addition to the "symbol-concatenation" problem (explained in the other answer), it seems that TEMP needs to be reset to 1.0 for every I (to calculate the Lagrange polynomial for each grid point), plus we need to multiply it by the functional value on that point (Y(I)). After fixing these
PROGRAM LAGRANGE
implicit none !<-- always recommended
REAL :: X(0:100), Y(0:100), INTERP, TEMP, POLINOM
integer :: I, J, K, N
N = 10
X = 0.0
Y = 0.0
!! Test data (sin(x) over [0,2*pi]).
DO I = 0, N
X(I) = real(I) / real(N) * 3.14159 * 2.0
Y(I) = sin( X(I) )
END DO
WRITE(*,*) "Data table:"
DO I = 0, N
WRITE(*,*) X(I), Y(I)
END DO
interp = 0.5 !! test value
POLINOM = 0.0
DO I = 0, N
TEMP = 1.0 !<-- TEMP should be reset to 1.0 for every I
DO J = 0, N
IF( J /= I ) THEN
TEMP = TEMP * (interp - X(J)) / (X(I) - X(J))
END IF
END DO
TEMP = TEMP * Y(I) !<-- also needs this
POLINOM = POLINOM + TEMP
END DO
print *, "approx : ", POLINOM
print *, "exact : ", sin( interp )
end
we get a pretty good agreement between the approximate (= interpolated) and exact results:
Data table:
0.00000000 0.00000000
0.628318012 0.587784827
1.25663602 0.951056182
1.88495409 0.951056957
2.51327205 0.587786913
3.14159012 2.53518169E-06
3.76990819 -0.587782800
4.39822626 -0.951055467
5.02654409 -0.951057792
5.65486193 -0.587789178
6.28318024 -5.07036339E-06
approx : 0.479412317
exact : 0.479425550
Consider the (complete) program
real x = 1.
end
What does this do?
If this is free-form source then it is an invalid program. If it is fixed-form source then it is a valid program.
In fixed-form source, spaces after column 6 largely have no effect. The program above is exactly like
realx=1.
end
and we can see that we're just setting an implicitly declared real variable called realx to have value 1..
implicit none
real x = 1.
end
will show a problem.
In free-form source, initialization in a declaration statement requires ::, like so:
real :: x = 1.
end
And: use implicit none.
I have been writing a script in fortran 90 for solving the radial oscillation problem of a neutron star with the use of shooting method. But for unknown reason, my program never works out. Without the shooting method component, the program runs smoothly as it successfully constructed the star. But once the shooting comes in, everything dies.
PROGRAM ROSCILLATION2
USE eos_parameters
IMPLICIT NONE
INTEGER ::i, j, k, l
INTEGER, PARAMETER :: N_ode = 5
REAL, DIMENSION(N_ode) :: y
REAL(8) :: rho0_cgs, rho0, P0, r0, phi0, pi
REAL(8) :: r, rend, mass, P, phi, delta, xi, eta
REAL(8) :: step, omega, omegastep, tiny, rho_print, Radius, B, a2, s0, lamda, E0, E
EXTERNAL :: fcn
!!!! User input
rho0_cgs = 2.D+15 !central density in cgs unit
step = 1.D-4 ! step size dr
omegastep = 1.D-2 ! step size d(omega)
tiny = 1.D-8 ! small number P(R)/P(0) to define star surface
!!!!!!!!!
open(unit=15, file="data.dat", status="new")
pi = ACOS(-1.D0)
a2 =((((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6))**(0.5D0))*a2_MeV !convert to code unit (km^-1)
B = ((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6)*B_MeV !convert to code unit (km^-2)
s0 = (1.D0/3.D0) - (1/(6*pi**2))*a2*((1/(16*pi**2)*a2**2 + (pi**-2)*a4*(rho0 - B))**-0.5) !square of the spped of sound at r=0
lamda = -0.5D0*log(1-2*y(1)/r)
E0 = (r0**-2)*s0*exp(lamda + 3*phi0)
rho0 = rho0_cgs*6.67D-18 / 9.D0 !convert rho0 to code unit (km^-2)
!! Calculate central pressure P0
P0 = (1.D0/3.D0)*rho0 - (4.D0/3.D0)*B - (1.D0/(a4*(12.D0)*(pi**2)))*a2**2 - &
&(a2/((3.D0)*a4))*(((1.D0/(16.D0*pi**4))*a2**2+(1.D0/(pi**2))*a4*(rho0-B))**0.5D0)
!! initial value for metric function phi
phi0 = 0.1D0 ! arbitrary (needed to be adjusted later)
r0 = 1.D-30 ! integration starting point
!! Set initial conditions
!!!!!!!!!!!!!!!!!
!!Start integration loop
!!!!!!!!!!!!!!!!!
r = r0
y(1) = 0.D0
y(2) = P0
y(3) = phi0
y(4) = 1/(3*E0)
y(5) = 1
omega = 2*pi*1000/(2.997D5) !omega of 1kHz in code unit
DO l = 1, 1000
omega = omega + omegastep !shooting method part
DO i = 1, 1000000000
rend = r0 + REAL(i)*step
call oderk(r,rend,y,N_ode,fcn)
r = rend
mass = y(1)
P = y(2)
phi = y(3)
xi = y(4)
eta = y(5)
IF (P < tiny*P0) THEN
WRITE(*,*) "Central density (10^14 cgs) = ", rho0_cgs/1.D14
WRITE(*,*) " Mass (solar mass) = ", mass/1.477D0
WRITE(*,*) " Radius (km) = ", r
WRITE(*,*) " Compactness M/R ", mass/r
WRITE(15,*) (omega*2.997D5/(2*pi)), y(5)
GOTO 21
ENDIF
ENDDO
ENDDO
21 CONTINUE
END PROGRAM roscillation2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE fcn(r,y,yprime)
USE eos_parameters
IMPLICIT NONE
REAL(8), DIMENSION(5) :: y, yprime
REAL(8) :: r, m, P, phi, rho, pi, B, a2, xi, eta, W, Q, E, s, lamda, omega
INTEGER :: j
pi = ACOS(-1.D0)
a2 =((((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6))**(0.5D0))*a2_MeV !convert to code unit (km^-1)
B = ((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6)*B_MeV !convert to code unit (km^-2)
m = y(1)
P = y(2)
phi = y(3)
xi = y(4)
eta = y(5)
rho = 3.D0*P + 4.D0*B +((3.D0)/(4.D0*a4*(pi**2)))*a2**2+(a2/a4)*&
&(((9.D0/((16.D0)*(pi**4)))*a2**2+((3.D0/(pi**2))*a4*(P+B)))**0.5D0)
s = (1.D0/3.D0) - (1/(6*pi**2))*a2*((1/(16*pi**2)*a2**2 + (pi**-2)*a4*(rho - B))**-0.5) !square of speed of sound
W = (r**-2)*(rho + P)*exp(3*lamda + phi)
E = (r**-2)*s*exp(lamda + 3*phi)
Q = (r**-2)*exp(lamda + 3*phi)*(rho + P)*((yprime(3)**2) + 4*(r**-1)*yprime(3)- 8*pi*P*exp(2*lamda))
yprime(1) = 4.D0*pi*rho*r**2
yprime(2) = - (rho + P)*(m + 4.D0*pi*P*r**3)/(r*(r-2.D0*m))
yprime(3) = (m + 4.D0*pi*P*r**3)/(r*(r-2.D0*m))
yprime(4) = y(5)/(3*E)
yprime(5) = -(W*omega**2 + Q)*y(4)
END SUBROUTINE fcn
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
!! Runge-Kutta method (from Numerical Recipes)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine oderk(ri,re,y,n,derivs)
INTEGER, PARAMETER :: NMAX=16
REAL(8) :: ri, re, step
REAL(8), DIMENSION(NMAX) :: y, dydx, yout
EXTERNAL :: derivs,rk4
call derivs(ri,y,dydx)
step=re-ri
CALL rk4(y,dydx,n,ri,step,yout,derivs)
do i=1,n
y(i)=yout(i)
enddo
return
end subroutine oderk
SUBROUTINE RK4(Y,DYDX,N,X,H,YOUT,DERIVS)
INTEGER, PARAMETER :: NMAX=16
REAL(8) :: H,HH,XH,X,H6
REAL(8), DIMENSION(N) :: Y, DYDX, YOUT
REAL(8), DIMENSION(NMAX) :: YT, DYT, DYM
EXTERNAL :: derivs
HH=H*0.5D0
H6=H/6D0
XH=X+HH
DO I=1,N
YT(I)=Y(I)+HH*DYDX(I)
ENDDO
CALL DERIVS(XH,YT,DYT)
DO I=1,N
YT(I)=Y(I)+HH*DYT(I)
ENDDO
CALL DERIVS(XH,YT,DYM)
DO I=1,N
YT(I)=Y(I)+H*DYM(I)
DYM(I)=DYT(I)+DYM(I)
ENDDO
CALL DERIVS(X+H,YT,DYT)
DO I=1,N
YOUT(I)=Y(I)+H6*(DYDX(I)+DYT(I)+2*DYM(I))
ENDDO
END SUBROUTINE RK4
Any reply would be great i am just really depressed for the long debugging.
Your program is blowing up because of this line:
yprime(5) = -(W*omega**2 + Q)*y(4)
in subroutine fcn. In this subroutine, omega is completely independent of the one declared in your main program. This one is uninitialized and used in an expression, which will either contain random values or zero, if your compiler is nice enough (or told) to initialize variables.
If you want the variable omega from your main program to be the same variable you use in fcn then you need to pass that variable to fcn somehow. Due to the way you've architected this program, passing it would require modifying all of your procedures to pass omega so that it can be provided to all of your calls to DERIVS (which is the dummy argument you are associating with fcn).
An alternative would be to put omega into a module and use that module where you need access to omega, e.g. declare it in eos_parameters instead of declaring it in the scoping units of fcn and your main program.
I don't know is this right room to ask this question of not. If not I am sorry for that.
I am new user for the fortran and spending a lot of time for the following stuff.
I have constructed a function called "loglike" which returns a real number depending on two parameters. I want to use this function to construct a mcmc algorithm
which goes like this.
psi = min(0, loglike(propalpha,propbeta) - loglike(currentalpha,currentbeta))
where propalpha = currentalpha + noise, and propbeta = currentbeta + noise, noises are random samples from some distribution.
Now I want to use this algorithm by calling previously constructed function "loglike".
1) how can I call the function 'loglike' for new program called main program
2) how can I use this for the subroutine?
Any help is very great for me.
Thanks in advance
EDIT:
module mcmc
implicit none
contains
subroutine subru(A,B, alphaprop, betaprop)
real, intent(in)::A,B
real, intent(out)::alphaprop, betaprop
end subroutine subru
real function aloglike(A,B)
real:: A,B,U, aloglike
aloglike = U
end function aloglike
end module mcmc
program likelihood
use mcmc
implicit none
real :: alpha,beta,dist1,dist2,prob1,prob2
real:: psi,a(1000),b(1000), u1, u2,u, alphaprop, betaprop
real, dimension(1:1):: loglike
integer :: t,i,j,k,l
real, dimension(1:625):: x
real, dimension(1:625):: y
integer, dimension(1:625):: inftime
alpha = 0.5
beta = 2.0
open(10, file = 'epidemic.txt', form = 'formatted')
do l = 1,625
read(10,*,end = 200) x(l), y(l), inftime(l)
enddo
200 continue
loglike = 0.0
do t=1,10
do i=1,625
if(inftime(i)==0 .or. t < (inftime(i)-1)) then
dist1 = 0.0
do j = 1, 625
if(t >= inftime(j) .and. inftime(j)/=0)then
dist1 = dist1 + sqrt((x(i) - x(j))**2 + (y(i) - y(j))**2)**(-beta)
endif
enddo
prob1 = 1 - exp(-alpha * dist1)
loglike = loglike + log(1 - prob1)
endif
if(inftime(i) .eq. (t+1)) then
dist2 = 0.0
do k=1, 625
if(t >= inftime(k) .and. inftime(k)/=0) then
dist2 = dist2 + sqrt((x(i) - x(k))**2 + (y(i) - y(k))**2)**(-beta)
endif
enddo
prob2 = 1 - exp(-alpha * dist2)
loglike = loglike + log(prob2)
endif
enddo
enddo
do i = 2, 1000
a(1)= 0.0
b(1) = 0.0
call subru(a(i),b(i), alphaprop, betaprop)
call random_number(u1)
call random_number(u2)
alphaprop = a(i-1) + (u1*0.4)-0.2
betaprop= b(i-1) + (u2*0.4)-0.2
if(alphaprop> 0 .and. alphaprop < 0.2 .and. betaprop > 0 .and. betaprop < 0.2)then
psi = min(0.0,aloglike(alphaprop,betaprop)- aloglike(a(i-1),b(i-1)))
call random_number(u)
if(u < psi)then
a(i)= alphaprop
b(i) = betaprop
else
a(i) = a(i-1)
b(i) = b(i-1)
endif
endif
enddo
do j = 1, 1000
print *, A(j), A(j), LOGLIKE
enddo
end program
The easiest and most reliable technique is to place your functions and subroutines in a module and "use" that module from your main program. This can be done in one file. This method makes the interfaces of the procedures (functions and subroutines) known so that the compiler can check consistency between arguments in the call (actual arguments) and called (dummy arguments). Sketch:
module mysubs
implicit none
contains
subroutine sub1 (xyz)
declarations
code
end subroutine sub1
function func2 (u)
declarations
code
func2 = ...
end func2
end module mysubs
program myprog
use mysubs
implicit none
declarations...
call sub1 (xyz)
q = func2 (z)
end program myprog
ADDED: "implicit none" is used to disable implicit typing, which is dangerous in my opinion. So you will need to type all of your variables, including the function name in the function. You can call the subroutines and functions from other procedures of the module -- they will automatically be known. So you can use "func2" from "sub1", if you wish. For entities outside of the module, such as your main program, you must "use" the module.
This is the general way it would look. Note that functions return a value by assigning the result to its own name. A return statement is not necessary.
C "loglike" is renamed "aloglike" so implicit typing uses REAL
C A type declaration could be used instead
function aloglike (alpha, beta)
aloglike = ... (expression which computes value)
end
program whateveryouwanttocallit
...
propalpha = ...
propbeta = ...
currentalpha = ...
currentbeta = ...
...
psi = min(0, aloglike(propalpha,propbeta) - aloglike(currentalpha,currentbeta))
print *, 'psi = ', psi
end