- #1
mattmac.nuke
- 22
- 0
I'm having some difficulty figuring out exactly what the issue is here. The compiler tells me that I'm lacking types for certain function variables, but when I define them in the module it tells me they are defined in multiple locations, and still won't compile. what can I do to absolve this?
Code:
MODULE space_data
REAL :: l !LENGTH OF THE BAR
REAL :: temp !TEMPERATURE IN KELVIN
REAL :: d_0 !CONSTANT DIFFUSION PARAMETER
REAL :: q !ACTIVATION ENERGY
REAL :: c_0 !INITIAL CONCENTRATION AT X=0
REAL :: r=8.31 !IDEAL GAS CONSTANT IN J/molK
REAL :: c_r !DESIRED END CONCENTRATION
INTEGER :: imax=30 !MAXIMUM ITERATIONS
REAL :: eps=1E-4 !MAXIUMUM ERROR
REAL :: a, b !INTERVAL OF EVALUATION [A,B]
REAL :: t
REAL :: exp, df !, erf, c, c_avg
END MODULE space_data
PROGRAM carburization
USE space_data
IMPLICIT NONE
CHARACTER :: choice
REAL :: y, x
INTEGER :: z
REAL ::
DO
WRITE(*,*) 'a) Enter new data'
WRITE(*,*) 'b) Calculate time until desired concentration'
WRITE(*,*) 'q) Quit'
WRITE(*,'(A,\)') 'Enter choice: '
READ(*,*) choice
SELECT CASE(choice)
CASE('A','a')
CALL call_data()
CASE('B','b')
CALL bisection(x, y, z)
CALL results()
CASE('Q','q')
STOP
END SELECT
END DO
END PROGRAM carburization
SUBROUTINE call_data()
USE space_data
IMPLICIT NONE
WRITE(*,'(A,\)') 'Enter initial end concentration (%): '
READ(*,*) c_0
WRITE(*,'(A,\)') 'Enter diffusion parameter (m^3/sec): '
READ(*,*) d_0
WRITE(*,'(A,\)') 'Enter activation energy (J): '
READ(*,*) q
WRITE(*,'(A,\)') 'Enter temperature (K): '
READ(*,*) temp
WRITE(*,'(A,\)') 'Enter length of bar (m): '
READ(*,*) l
WRITE(*,'(A,\)') 'Enter desired average final concentration (%): '
READ(*,*) c_r
WRITE(*,*) ''
WRITE(*,*) ' The bisection method needs an initial search interval [A,B].'
WRITE(*,*) ''
DO
WRITE(*,'(A,\)') 'Enter a A (Years):'
READ(*,*) a
WRITE(*,'(A,\)') 'Enter a B (Years):'
READ(*,*) b
IF(a < b) THEN
EXIT
ELSE
WRITE(*,*) 'Error- left end point needs to be smaller than right end point.'
WRITE(*,*) 'Please enter again:'
END IF
END DO
END SUBROUTINE call_data
SUBROUTINE bisection(f, root, ercode)
USE space_data
IMPLICIT NONE
INTEGER :: i
REAL, EXTERNAL :: f !THE FUNCTION WE WANT TO FIND THE ROOT OF
!REAL, INTENT(IN) :: a, b !INTERVAL OF EVALUATION [A,B]
REAL, INTENT(OUT) :: root !THE ROOT WE ARE TRYING TO FIND
REAL :: x1, x2, x3, f1, f2, f3, d, d01 !X VALUES, F(X) VALUES AND INTERVAL LENGTHS
INTEGER, INTENT(OUT) :: ercode !ERROR CODE WILL RETURN AN INT VALUE BASED ON OUTCOME
!-1 MEANS ITERATION CNT EXCEED
!-2 MEANS NO ROOT IN INTERVAL A-B
!-3 UNKNOWN ERROR
!0 ROOT FOUND, BISECTION METHOD SUCCESSFUL
d=1
x1=a
x3=b
f1 = f(x1)
f3 = f(x3)
IF (f1*f3 > 0) THEN
ercode = -2 !-2 MEANS NO ROOT IN INTERVAL A-B
ELSE
d=1
i=0
d01 = a - b
DO
x2 = (x1 + x3)/2.
f2 = f(x2)
IF(d < eps) THEN
root = x2
ercode = 0 !SUCCESS
EXIT
ELSE IF(i > imax) THEN
ercode = -1 !MEANS ITERATION CNT EXCEED
EXIT
END IF
IF(f1*f2 < 0) THEN !LEFT
d = (x2 - x1)/d01
f3 = f2
x3 = x2
ELSE IF(f2*f3 < 0) THEN !RIGHT
d = (x3 - x2)/d01
f1 = f2
x1 = x2
ELSE IF(f2 == 0) THEN
root = x2
ercode = 0 !SUCCESS
EXIT
ELSE
ercode = -3 !-3 UNKNOWN ERROR
EXIT
END IF
i = i + 1
END DO
END IF
END SUBROUTINE
REAL FUNCTION f()
USE space_data
IMPLICIT NONE
f = c_avg - c_r
END FUNCTION f
REAL FUNCTION c ()
USE space_data
IMPLICIT NONE
REAL :: z, x
df = d_0*(exp**(-q/(r*temp)))
x=l
z = x/(2*df*t)
c = (c_0/2.)*(1 - ERF(z))
END FUNCTION c
REAL FUNCTION c_avg ()
USE space_data
IMPLICIT NONE
REAL :: delta_x, idx
INTEGER :: i
delta_x = .2
DO i = 0, 5
idx = i*delta_x
c_avg = c_avg + (1/6.)*( c(idx,t) )
END DO
END FUNCTION c_avg
SUBROUTINE results()
USE space_data
IMPLICIT NONE
WRITE(*, '(T5,A)') 'RESULTS:'
WRITE(*, '(T5, 50("-"))')
WRITE(*,'(T5, "|", 1X, A,T40, "|", F12.3, 1X, "|")') 'Initial end concentration (%)',c_0
WRITE(*,'(T5, "|", 1X, A,T40, "|", ES12.3, 1X, "|")') 'Diffusion parameter (m^3/sec):',d_0
WRITE(*,'(T5, "|", 1X, A,T40, "|", ES12.3, 1X, "|")') 'Activationenergy (J):',q
WRITE(*,'(T5, "|", 1X, A,T40, "|", F12.2, 1X, "|")') 'Temperature (K):',temp
WRITE(*,'(T5, "|", 1X, A,T40, "|", F12.2, 1X, "|")') 'Length of bar (m):',l
WRITE(*,'(T5, "|", 1X, A,T40, "|", F12.3, 1X, "|")') 'Final concentration (%):',c_r
WRITE(*, '(T5, 50("-"))')
WRITE(*,'(T5, "|", 1X, A,T40, "|", F12.3, 1X, "|")') 'Computed diffusion time (days):',t
WRITE(*, '(T5, 50("-"))')
WRITE(*,*)
END SUBROUTINE results
Last edited by a moderator:
