FORTRAN Help: Functions and Subroutines

  • Comp Sci
  • Thread starter mattmac.nuke
  • Start date
  • #1
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:

Answers and Replies

  • #2
uart
Science Advisor
2,776
9
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?
There a few different ways to deal with this, and I'm sure there are better ways, but the simplest is to just move the function definitions inside the main program with the use of the "contains" directive.


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

CONTAINS

SUBROUTINE call_data()
USE space_data
IMPLICIT NONE
...
...
...
...
END SUBROUTINE results

END PROGRAM carburization
 
Last edited:

Related Threads on FORTRAN Help: Functions and Subroutines

Replies
6
Views
1K
Replies
2
Views
1K
Replies
3
Views
6K
  • Last Post
Replies
16
Views
2K
Replies
5
Views
1K
  • Last Post
Replies
1
Views
3K
  • Last Post
Replies
4
Views
3K
Replies
4
Views
6K
  • Last Post
Replies
7
Views
822
Top