Introduction to F

Fortran was introduced in 1957 and remains the language of choice for most scientific programming. Some of the most important features of Fortran 90 include recursive subroutines, dynamic storage allocation and pointers, user defined data structures, modules, and the ability to manipulate entire arrays.

Fortran 90 is compatible with Fortran 77 and includes syntax that is no longer desirable. F is a subset of Fortran 90 that includes only its modern features and is compact and easy to learn.

1. Introduction 2. Do construct 3. If construct 4. Subprograms
5. Formatted output 6. Files 7. Arrays 8. Allocate
9. Random number sequences 10. Recursion 11. Character variables 12. Complex variables
13. References and links

The simplest way to use the F subset of Fortran is to use the option -std=F with the g95 compiler: g95 -std=F ProductExample.f95

1. Introduction

An example of a simple F program.
program ProductExample
   real :: m, a, force
   m = 2.0                       ! mass in kilograms
   a = 4.0                       ! acceleration in mks units
   force = m*a                   ! force in newtons
print *, force
end program ProductExample
The features of F in Program ProductExample include the following:

We next introduce syntax that allows the user to enter the desired values of m and a from the keyboard. Note the use of the (unformatted) read statement and how character strings are printed.

program ReadInput
   real :: m, a, force
   ! SI units
   print *, "mass m = ?"
   read *, m
   print *, "acceleration a = ?"
   read *, a
   force = m*a
   print *, "force (in newtons) =", force
end program ReadInput

2. Do construct

An example of the do construct to execute the same statements more than once:
program Series
   real :: sumOfSeries       ! sum is a keyword
   integer :: n
   sumOfSeries = 0.0
   ! add first 100 terms
   do n = 1, 100
      sumOfSeries = sumOfSeries + 1.0/real(n)**2       ! real is example of intrinsic funcion
      print *, n,sumOfSeries
   end do
end program Series
Note that n is an integer variable. In this example the do statement specifies the first and last values of n; n increases by unity (default). The block of statements inside a loop is indented for clarity.

Because the product n*n is done using integer arithmetic, it is better to convert n to a real variable before the multiplication is done. Exponentiation is done using the operator **.

3. If construct

The do loop can be exited by satisfying a test.
program SeriesTest
   ! illustrate use of do construct
   integer :: n
   ! choose large value for relative change
   real :: sumOfSeries, newterm, relativeChange
   n = 0
   sumOfSeries = 0.0
   do
      n = n + 1
      newterm = 1.0/(n*n)
      sumOfSeries = sumOfSeries + newterm
      relativeChange = newterm/sumOfSeries
      if (relativeChange < 0.0001) then
         exit
      end if
      print *, n, relativeChange, sumOfSeries
   end do
end program SeriesTest
The features included in program SeriesTest include:
relation operator
less than <
less than or equal <=
equal ==
not equal /=
greater than >
greater than or equal >=
Table 1. Summary of relational operators.

The following program illustrates the use of the kind parameter and a named do construct:

program SeriesDouble
   ! illustrate use of kind parameter and named do loop
   integer, parameter :: double = 8     ! use for double precision
   integer :: n
   real (kind = double) :: sumOfSeries, newterm, relativeChange
   n = 0
   sumOfSeries = 0.0
   printChange: do
      n = n + 1
      newterm = 1.0/real(n, kind = double)**2
      sumOfSeries = sumOfSeries + newterm
      relativeChange = newterm/sumOfSeries
      if (relativeChange < 0.0001) then
         exit printChange
      end if
      print *, n,relativeChange,sumOfSeries
   end do printChange
end program SeriesDouble

A more general use of the parameter statement is given in Program drag.

4. Subprograms

Subprograms are called from the main program or other subprograms. As an example, the following program adds and multiplies two numbers that are inputed from the keyboard. The variables x and y are public and are available to the main program.

module common
   public :: initial, add, multiply      ! subroutines
   integer, parameter, public :: double = 8
   real (kind = double), public :: x,y

contains

subroutine initial()
   print *, "x = ?"
   read *,x
   print *, "y = ?"
   read *,y
end subroutine initial

subroutine add(sum2)
   real (kind = double), intent (in out) :: sum2
   sum2 = x + y
end subroutine add

subroutine multiply(product2)
   real (kind = double), intent (in out) :: product2
   product2 = x*y
end subroutine multiply

end module common

program tasks            ! illustrate use of module and subroutines
   ! note how variables are passed
   use common
   real (kind = double) :: sum2, product2
   call initial()                 ! initialize variables
   call add(sum2)                 ! add two variables
   call multiply(product2)
   print *, "sum =", sum2, "product =", product2
end program tasks

5. Formatted output

The structure of Program cool is similar to Program tasks. Note the use of the modulo function and the use of format specifications. We have used a format specification, which is a list of edit descriptors. An example from Program cool is

print "(t7,a,t16,a,t28,a)", "time","T_coffee","T_coffee - T_room"
The t (tab) edit descriptor is used to skip to a specified position on an output line. The edit descriptor a (alphanumeric) is for character strings. An example of the f (floating point) descriptor is given by
print "(f10.2,2f13.4)",t,T_coffee,T_coffee - T_room
The edit descriptor f13.4 means that a total of thirteen positions are reserved for printing a real value rounded to 4 places after the decimal point. (The decimal point and a minus sign occupy two of the thirteen positions.) The edit descriptor 2f13.4 means that the edit descriptor f13.4 is used twice. Another common edit descriptor is i (integer).

Comment on Program drag

The only new syntax in Program drag is the use of the parameter statement:

real (kind = double), public, parameter :: g = 9.8
A parameter is a named constant. The value of a parameter is fixed by its declaration and cannot be changed during the execution of a program.

6. Files

Program saveData illustrates how to open a new file, write data in a file, close a file, and read data from an existing file.

program saveData
   ! illustrate writing and reading file
   integer :: i,j,x
   character(len = 32) :: file_name
   print *, "name of file?"
   read *, file_name
   open (unit=5,file=file_name,action="write",status="new")
   do i = 1,4
      x = i*i
      write (unit=5,fmt=*) i,x
   end do
   close(unit=5)
   ! open(unit=1,file=file_name,action="read",status="old")
   open(unit=1,file=file_name,position="rewind",action="read",status="old")
   do i = 1,4
      read (unit=1,fmt = *) j,x
      print *, j,x
   end do
   close(unit=1)
end program saveData

Input/output statements refer to a particular file by specifying its unit. The read and write statements do not refer to a file directly, but refer to a file number which must be connected to a file. There are many variations on the open statement, but the above example is typical. The values of the action specifier are read, write, and readwrite (default). Values for status are old, new, replace, or scratch.

If you plan to reuse data on the same system with the same compiler, you can use unformatted input/output to save the overhead, extra space, and the roundoff error associated with the conversion of the internal representation of a value to its external representation. Of course, the latter is machine and compiler dependent. Unformatted access is very useful when data is generated by one program and then analyzed by a separate program on the same computer. To generate unformatted files, omit the format specification. Examples of programs which use direct access and records are available.

7. Arrays

The definition and use of arrays is illustrated in Program vector.

module common
   public :: initial,cross
   contains

   subroutine initial(a,b)
      real, dimension (:), intent(out) :: a,b
      a(1:3) = (/ 2.0, -3.0, -4.0 /)
      b(1:3) = (/ 6.0, 5.0, 1.0 /)
   end subroutine initial

   subroutine cross(r,s)
      real, dimension (:), intent(in) :: r,s
      real, dimension (3) :: cross_product
      ! note use of dummy variables
      integer :: component,i,j
      do component = 1,3
         i = modulo(component,3) + 1
         j = modulo(i,3) + 1
         cross_product(component) = r(i)*s(j) - s(i)*r(j)
      end do
      print *, ""     ! skip line
      print *, "three components of the vector product:"
      print "(a,t10,a,t16,a)", "x","y","z"
      print *, cross_product
   end subroutine cross

   end module common

   program vector            ! illustrate use of arrays
      use common
      real, dimension (3) :: a,b
      real :: dot
      call initial(a,b)
      dot = dot_product(a,b)
      print *, "dot product = ", dot
      call cross(a,b)
   end program vector
The main features of arrays include:

An array is declared in the declaration section of a program, module, or procedure using the dimension attribute. Examples include

real, dimension (10) :: x,y
integer, dimension (-10:10) :: prob
integer, dimension (10,10) :: spin ! example of two-dimensional array
a(1:3) = (/ 2.0, -3.0, -4.0 /)
is equivalent to the separate assignments
a(1) = 2.0
a(2) = -3.0
a(3) = -4.0
print *, cross_product

Fortran 90 has many vector and matrix multiplication functions. For example, the function dot_function operates on two vectors and returns their scalar product. Some useful array reduction functions are maxval, minval, product, and sum.

8. Allocate statement

The size of an array can be changed during the execution of the program. The use of the allocate and deallocate statements are illustrated in the following. Note the use of the implied do loop.

program dynamicArray
   ! example of dynamic arrays
   real, dimension (:), allocatable :: x
   integer :: i, N
   N = 2
   allocate(x(N:2*N))
   ! implied do loop
   x(N:2*N) = (/ (i*i, i = N, 2*N) /)
   print *, x
   deallocate(x)
   allocate(x(N:3*N))
   x = (/ (i*i, i = N, 3*N) /)
   print *, x
end program dynamicArray
An example of passing arrays:
module param
   integer, public, parameter :: double = 8
end module param

module common
   use param
   private
   public :: initial
   integer, public :: N
   contains

   subroutine initial(x)
      real (kind = double), intent(inout), dimension(:) :: x
      N = 100
      x(1) = 1.0
   end subroutine initial
end module common

program test
   use param
   use common
   real (kind = double), allocatable,dimension (:) :: x
   N = 10
   allocate(x(N))
   call initial(x)
end program test

9. Random number sequences

A convenient intrinsic procedure is subroutine random_number. Although it is a good idea to write your own random number generator using an algorithm that you have tested on a particular problem of interest, it is convenient to use subroutine random_number when you are debugging your program or if accuracy is not important. The following program illustrates several uses of subroutine random_number and random_seed. Note that the argument rnd of random_number must be real, has intent out, and can be either a scalar or an array.

program randomExample
   real :: rnd
   real, dimension (:), allocatable :: x
   integer, dimension (:), allocatable:: seed, seed_present
   integer :: L, i, m, nmin, nmax, randomInteger
   ! generate random integers between nmin and nmax
   ! dimension of seed is one in F and two in Fortran 90
   call random_seed()        ! initialize random number generator
   call random_number(rnd)   ! generate random number
   print *, "random number = ", rnd
   call random_seed(size=m)      ! random_seed in gfortran requires m integers to start
   print *,"# seeds needed = ", m
   allocate(seed(m))
   ! put is integer vector that puts the desired seeds into random number generator
   do i = 1,m
      seed(i) = 12345 + i
   end do
   call random_seed(put=seed)    ! assign seeds
   ! get is integer vector which reads present seeds
   allocate(seed_present(m))
   call random_seed(get=seed_present)         ! confirm seeds
   print *, "seeds = ", seed_present
   call random_number(rnd)
   call random_seed(get=seed_present)
   print *, "new seeds = ", seed_present      ! confirm value of new seed
   ! generate L random integers between nmin and nmax
   L = 10         ! length of sequence
   nmin = 5
   nmax = 15
   do i = 1, L
      call random_number(rnd)
      randomInteger = (nmax - nmin + 1)*rnd + nmin
      print *, "random integer = ", randomInteger
   end do
   allocate(x(L))         ! assign random numbers to array x
   call random_number(x)
   print "(4f13.6)", x
   call random_seed(get=seed_present)
   ! find new seed so can start program from where the program stopped
   print *, "new seed = ", seed_present
end program randomExample
Note how subroutine random_seed is used to specify the seed. This specification is useful when the same random number sequence is used to test a program.

10. Recursion

A simple example of a recursive definition is the factorial function:

factorial(n) = n! = n(n-1)(n-2) ... 1
A recursive definition of the factorial is
factorial(1) = 1 factorial(n) = n factorial(n-1)

A program that closely parallels the above definition follows. Note how the word recursive is used.

module fact

public :: f
contains

recursive function f(n) result (factorial_result)
   integer, intent (in) :: n
   integer :: factorial_result

   if (n <= 1) then
      factorial_result = 1
   else
      factorial_result = n*f(n-1)
   end if
end function f

end module fact

program test_factorial
   use fact
   integer :: n
   print *, "integer n?"
   read *, n
   print "(i4, a, i10)", n, "! = ", f(n)
end program test_factorial

A more detailed example (taken from pp. 98-99 in The Fun of Computing,John G. Kemeny, True BASIC (1990)) is given two integers, n and m, what is their greatest common divisor, that is, the largest integer that divides both? For example, if n = 1000 and m = 32, than the greatest common divisor (gcd) is gcd = 8.

One method for finding gcd is to integer divide n by m. We write n = q m + r, where q is the quotient and r is the remainder. If r = 0, then m divides n and m is the gcd. Otherwise, any divisor of m and r also divides n, and hence gcd(n,m) = gcd(m,r). Because r < m, we have made progress. As an example, take n = 1024 and m = 24. Then q = 42 and r = 16. So we want gcd(24,16). Now q = 1 and r = 8 and we calculate gcd(16,8). Finally q = 2, and r = 0 so gcd = 8. The following program implements this idea.

module gcd_def

public :: gcd
contains

recursive function gcd(n,m) result (gcd_result)
   integer, intent (in) :: n,m
   integer :: gcd_result
   integer :: remainder

   remainder = modulo(n,m)
   if (remainder == 0) then
      gcd_result = m
   else
      gcd_result = gcd(m,remainder)
   end if
end function gcd

end module gcd_def

program greatest
   use gcd_def

   integer :: n,m
   print *, "enter two integers n, m"
   read *, n,m
   print "(a,i6,a,i6,a ,i6)", "gcd of",n," and",m,"=",gcd(n,m)
end program greatest

The volume of a d-dimensional hypersphere of unit radius can be related to the area of a (d - 1)-dimensional hypersphere. The following program uses a recursive subroutine to integrate numerically a d-dimensional hypersphere:

module common
   public :: initialize,integrate

   integer, parameter, public :: double = 8
   real (kind = double), parameter, public :: zero = 0.0
   real (kind = double), public :: h, volume
   integer, public :: d

contains

subroutine initialize()
   print *, "dimension d?"
   read *, d                         ! spatial dimension
   print *, "integration interval h?"
   read *, h
   volume = 0.0
end subroutine initialize

recursive subroutine integrate(lower_r2, remaining_d)
   ! lower_r2 is contribution to r^2 from lower dimensions
   real(kind = double),intent (in) :: lower_r2
   integer, intent (in) :: remaining_d  ! # dimensions to integrate
   real (kind = double) :: x
   x = 0.5*h   ! mid-point approximation
   if (remaining_d > 1) then
      lower_d: do
         call integrate(lower_r2 + x**2, remaining_d - 1)
         x = x + h
         if (x > 1) then
            exit lower_d
         end if
      end do lower_d
   else   
      last_d: do
         if (x**2 + lower_r2 <= 1) then
           volume = volume + h**(d - 1)*(1 - lower_r2 - x**2)**0.5
         end if
         x = x + h
         if (x > 1) then
            exit last_d
         end if
      end do last_d
   end if
end subroutine integrate

end module common

program hypersphere
   ! original program by Jon Goldstein
   use common
   call initialize()
   call integrate(zero, d - 1)
   volume = (2**d)*volume         ! only consider positive octant
   print *, volume
end program hypersphere

11. Character variables

The only intrinsic operator for character expressions is the concatenation operator //. For example, the concatenation of the character constants string and beans is written as

"string"//"beans"
The result, stringbeans, may be assigned to a character variable.

A useful example of concatenation is given in the following:

program write_files
   ! open n files and write data
   integer :: i,n
   character(len = 15) :: file_name
   n = 11
   do i = 1,n
      ! assign number.dat to file_name using write statement
      write(unit=file_name,fmt="(i2.2,a)") i,".dat" 
      ! // is concatenation operator
      file_name = "config"//file_name
      open (unit=1,file=file_name,action="write",status="replace")
      write (unit=1, fmt=*) i*i,file_name
      close(unit=1)
   end do
end program write_files
Note the use of the write statement to build a character string for numeric and character components.

12. Complex variables

Fortran 90 is well suited for treating complex variables. The following program illustrates the way complex variables are defined and used.

program complexExample
   integer, parameter :: double = 8
   real (kind = double), parameter :: pi = 3.141592654
   complex (kind = double) :: b,bstar,f,arg
   real (kind = double) :: c
   complex :: a
   integer :: d
   ! A complex constant is written as two real numbers, separated by
   ! a comma and enclosed in parentheses.
   a = (2,-3)
   ! Both components must have same kind
   b = (0.5_double,0.8_double)
   print *, "a =", a      ! note that a has less precision than b
   print *, "a*a =", a*a
   print *, "b =", b
   print *, "a*b =", a*b
   c = real(b)           ! real part of b
   print *, "real part of b =", c
   c = aimag(b)      ! imaginary part of b
   print *, "imaginary part of b =", c
   d = int(a)
   print *, "real part of a (converted to integer) =", d
   arg = cmplx(0.0,pi)
   b = exp(arg)       ! done in two lines for ease of reading only
   bstar = conjg(b)    ! complex conjugate of b
   f = abs(b)       ! absolute value of b
   print *, "properties of b =", b,bstar,b*bstar,f
end program complexExample

13. References and Links

Walter S. Brainerd, Charles H. Goldberg, and Jeanne C. Adams, Programmer's Guide to F, Unicomp (1996).

Michael Metcalf and John Reid, The F Programming Language, Oxford University Press (1996).

13. Links

Acknowledgements

Program save_data was modified by Ty Faechner, 18 June 2003.

Please send comments and corrections to Harvey Gould, hgould@clarku.edu.

Updated 12 March 2013

© 2013 Harvey Gould.