1. Not finding help here? Sign up for a free 30min tutor trial with Chegg Tutors
    Dismiss Notice
Dismiss Notice
Join Physics Forums Today!
The friendliest, high quality science and math community on the planet! Everyone who loves science is here!

FORTRAN Help: Functions and Subroutines

  1. Oct 15, 2011 #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 (Text):


    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: Oct 16, 2011
  2. jcsd
  3. Oct 15, 2011 #2

    uart

    User Avatar
    Science Advisor

    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: Oct 16, 2011
Know someone interested in this topic? Share this thread via Reddit, Google+, Twitter, or Facebook




Similar Discussions: FORTRAN Help: Functions and Subroutines
  1. Fortran help (Replies: 16)

Loading...