Advanced Fortran Examples & Information

All Fortran I/O takes place through a data structure called a record. A record can be a single character or a sequence of characters or values. A record might be a line of text, the data received from a bar code reader, or the coordinates to move a plotter pen. Files are a collection of records. Fortran uses three types of records:

  • Formatted
  • Unformatted
  • Endfile

Input/Output FORM

Input and output data transfer is either formatted or
unformatted. The type of data transfer is established with the FORM= specifier when the file is opened.

FORM=”FORMATTED”
FORM=”UNFORMATTED”
FORM=”BINARY”
OPEN(1, FILE=”TEST”, FORM=”UNFORMATTED”,…)

Direct Access

REAL ECHO(128, 10000)

OPEN (17, FILE=“SEISMIC.DAT”, ACCESS=“DIRECT”, RECL=512)

DO I=1, 10000
READ (17, REC=I) ECHO(1,I)
END DO

Implied DO Lists

REAL, DIMENSION(5,5) :: a = RESHAPE((/(i,i=1,25)/),(/5,5/))
PRINT “(5f6.2)”, ((a(i,j), j=1,5), i=1,5)
END
1.00 6.00 11.00 16.00 21.00
2.00 7.00 12.00 17.00 22.00
3.00 8.00 13.00 18.00 23.00
4.00 9.00 14.00 19.00 24.00
5.00 10.00 15.00 20.00 25.00

Automatic Character Entity

SUBROUTINE SWAP(A, B)
CHARACTER(LEN=*) :: A, B
CHARACTER(LEN=LEN(A)) :: TEMP
TEMP = A
A = B
B = TEMP
RETURN
END

Array Constructors

(/1, 2, 3, 1, 2, 3, 1, 2, 3/)
or:
(/ ((i, i=1,3), j=1,3) /)

(/0, 1, 0, 1, 0, 1, 0, 1, 0, 1/)
or:
(/ (0,1, i=1,5) /)

INTEGER, DIMENSION(10) :: M, N
M = (/ (0,1, i=1,5) /)
N = (/ (M+1) /)

Array Conformance

Two arrays of the same shape are said to be conformable.
Array assignments can only be performed when both the left
and right hand sides are conformable. The RESHAPE function
is available to change the shape of an array.

REAL, DIMENSION(2,3) :: a
REAL, DIMENSION(3,2) :: b

a = (/1.,2.,3.,4.,5.,6./) <— produces an error
b = a <— produces an error

a = RESHAPE((/1.,2.,3.,4.,5.,6./), (/2,3/))
b = RESHAPE(a, (/3,2/))

Array-Valued Functions

A function may return an array. However, whenever such a
function is referenced, it must always have an explicit
interface.

FUNCTION VADD(a, r)
REAL, DIMENSION(:) :: a
REAL r
REAL, DIMENSION(SIZE(a)) :: VADD
VADD = a+COS(r)
RETURN
END

WHERE Statement/Construct

The WHERE statement allows an array operation to be
performed conditionally. This is called a masked assignment.

WHERE (expr) assignment-statement
[name:] WHERE (expr)
where-body
[ELSEWHERE (expr)[name]
where-body]
[ELSEWHERE [name]
where-body]
END WHERE [name]

FORALL Statement/Construct

The FORALL statement is used to perform array assignments,
possibly masked, on an element by element basis.

FORALL (trp_spec [,trp_spec]… [,mask_expr] )assign_stmt

[name:] FORALL (trpl_spec [,trp_spec]… [,mask_expr] )assign_stmt
forall_body_construct
END FORALL [name]
trp_spec is a triplet specification of an index variable
normally used as an array element index.

index = subscript : subscript [: stride]


Derived data types are useful for manipulating and maintaining data objects that are most suitably organized as an aggregate. Derived data types are also known as user defined data types.

Copy-In/Copy-out

integer, dimension(5,5) :: m = reshape((/(i,i=1,25)/),(/5,5/))
call sub(m(2:4,1::2),3,3)
call sub(m(1::2,2:4),3,3)
end

subroutine sub(m,nx,ny)
integer, dimension(nx,ny) :: m
print *,m
end

2 3 4 12 13 14 22 23 24
6 8 10 11 13 15 16 18 20

Using Derived Data Types

Derived types have declaration statements, initialization syntax, and assignment statements.

TYPE(DATE) :: DateA, DateB
TYPE(DATE) :: DateC = DATE(5,12,2001)

DateA%Month = 7
DateA%Day = 12
DateA%Year = 2002

DateC = DATE(5,12,2001)
DateB = DateA

Operations on Derived Types

MODULE DATES
TYPE DATE
INTEGER Month, Day, Year
END TYPE DATE

CONTAINS
LOGICAL FUNCTION DatesEqual(A, B)
TYPE(DATE) A, B
IF ((A%Month == B%Month) .AND. &
(A%Day == B%Day) .AND. &
(A%Year == B%Year)) THEN
DatesEqual = .TRUE.
ELSE
DatesEqual = .FALSE.
ENDIF
END FUNCTION DatesEqual
END MODULE DATES

Overloaded Intrinsic Operator

MODULE DATES
TYPE DATE; INTEGER Month, Day, Year; END TYPE DATE

INTERFACE OPERATOR(==)
MODULE PROCEDURE DatesEqual
END INTERFACE

PRIVATE DatesEqual

CONTAINS
LOGICAL FUNCTION DatesEqual(A, B)
TYPE(DATE), INTENT(IN) :: A, B
IF ((A%Month == B%Month) .AND. &
(A%Day == B%Day) .AND. &
(A%Year == B%Year)) THEN
DatesEqual = .TRUE.
ELSE
DatesEqual = .FALSE.
ENDIF
END FUNCTION DatesEqual
END MODULE DATES

User Defined Operator

PROGRAM MAIN
USE strings
CHARACTER(LEN=10) :: S1, S2
CHARACTER(LEN=20) :: R1, R2
S1 = “ABCDE”
S2 = “FGHIJ”
R1 = S1//S2
R2 = S1 .CONCAT. S2
PRINT “(A/A)”, R1, R2
END PROGRAM MAIN

ABCDE FGHIJ
ABCDEFGHIJ

Derived Type Declarations

PROGRAM Main
USE DATES
TYPE(DATE), DIMENSION(2) :: A

A(1)%Month = 2
A(1)%Day = 10
A(1)%Year = 2002

A(2) = DATE(2, 11, 2002)

IF (A(1) == A(2)) PRINT *,”Equal”

END PROGRAM Main

Useful Function

PRIVATE DateToInteger

CONTAINS
INTEGER FUNCTION DateToInteger(A)
TYPE(DATE), INTENT(IN) :: A
DateToInteger = A%Year*10000+A%Month*100+A%Day
END FUNCTION DateToInteger

LOGICAL FUNCTION DatesLT(A, B)
TYPE(DATE), INTENT(IN) :: A, B
DatesLT = .FALSE.
IF (DateToInteger(A) < DateToInteger(B)) DatesLT = .TRUE.
END FUNCTION DatesLT

Generic Interfaces

INTERFACE LOGB
FUNCTION SP_LOGB(X)
REAL(KIND(1.0E0)) :: SP_LOGB, X
END FUNCTION SP_LOGB
FUNCTION DP_LOGB(X)
REAL(KIND(1.0D0)) :: DP_LOGB, X
END FUNCTION DP_LOGB
END INTERFACE LOGB

Recursion Example

The function N! = Nx(N-1)…2×1 lends itself to recursive
programming.

INTEGER RECURSIVE FUNCTION Factorial(n) RESULT(r)
IF (n == 1) THEN
r = 1
ELSE
r = n*Factorial(n-1)
END IF
END FUNCTION Factorial


 

A pointer is an object that can be made to point to other objects. If the object that a pointer points to is not itself a pointer, it must have the TARGET attribute.

Pointers

A powerful use of pointers is to create linked lists.
TYPE Style
INTEGER index
REAL value
TYPE(Style), POINTER :: next
END TYPE Style

TYPE(Style), POINTER :: Head, Current, Next

ALLOCATE(Head)
Head = Style(1, 0.0, NULL())

Pointer Functions

A function can return a pointer.

integer, dimension(10) :: m = (/123, 87, 55, 203, 88, 908, 13, 792, 66, 118/)
integer, dimension(:), pointer :: p

p => pick(m, 100)
print *,p

contains

function pick(m, limit)
integer, dimension(:), pointer :: pick
integer, dimension(:) :: m
j = 0; do i=1,size(m); if (m(i) >= limit) j = j+1; end do
allocate (pick(j))
j = 0; do i=1,size(m); if (m(i) >= limit) then; j = j+1; pick(j) = m(i); end if; end do
end function pick

end

123 203 908 792 118

PRIVATE & PUBLIC Examples

REAL, PARAMETER, PRIVATE :: PI=3.1415926535

PRIVATE :: SP_LOGB, DP_LOGB

TYPE SEMAPHORE
PRIVATE
REAL, DIMENSION(), POINTER :: ACCESS
LOGICAL STATE
END TYPE SEMAPHORE

SAVE

Variables and arrays that are declared locally in subprogramsare allocated dynamically when the subprogram is invoked. When the subprogram executes a RETURN or END statement, these items are deallocated and lose their definition status. The SAVE attribute/statement is used to retain the definition status of these items.

REAL, SAVE :: A
SAVE A
SAVE


 

Fortran strings are a sequence of characters padded with blanks out to their full fixed length, while strings in C are an array of characters terminated by a null character. Therefore, when passing Fortran strings to C routines, you should terminate them with a null character. The following Fortran expression will properly pass the Fortran string to the C routine CPRINT

External Procedures

Fortran passes the lengths of strings by value as additional arguments at the end of the formal argument list. C programs can be constructed to take advantage of this.

CALL CFUN(‘string’)

void cfun(char *string, int length)

or:

(void) FFUN(char_array, strlen(char_array));

SUBROUTINE FFUN(string)
CHARACTER(LEN=*) string

IEEE Modules

The following example demonstrates a sequence to exercise program control over detection of an exception.

subroutine safe_divide(a, b, c, fail)
use IEEE_EXCEPTIONS
real a, b, c
logical fail
type(IEEE_STATUS_TYPE) status
! save the current floating-point environment, turn halting for
! divide-by-zero off, and clear any previous divide-by-zero flag
call IEEE_GET_STATUS(status)
call IEEE_SET_HALTING_MODE(IEEE_DIVIDE_BY_ZERO, .false.)
call IEEE_SET_FLAG(IEEE_DIVIDE_BY_ZERO, .false.)
! perform the operation
c = a/b
! determine if a failure occurred and restore the floating-point environment
call IEEE_GET_FLAG(IEEE_DIVIDE_BY_ZERO, fail)
call IEEE_SET_STATUS(status)
end subroutine safe_divide

VAX/UNIX Compatibility

The Unix library contains functions for determining the
number of command line arguments and returning the nth
argument from the command line.

character(len=32) :: arg(16)
n = iargc()
do i=1,n
call getarg(i, arg(i))
end do

LAPACK Example

The LAPACK routine DGESV performs Gaussian elimination
on a general dense matrix.

INTEGER, PARAMETER :: LDA=100, LDB=100, N=50, NRHS=50
INTEGER INFO, IPIV(N)
REAL(KIND(1.0D0)), DIMENSION(LDA,N) :: A
REAL(KIND(1.0D0)), DIMENSION(LDB,NRHS) :: B

CALL DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO)


 

Optimizations affect single statements, groups of statements or entire programs. Optimizations performed by the compiler can include:

common subexpression elimination loop permutation
constant propagation loop tiling
branch straightening loop skewing
strength reduction loop reversal
loop invariant removal unimodular transformations code hoisting forward substitution

Optimization Example

Array indexing in loops:

1. do i=1,n ! column indexing
do j=1,n
a(i,j) = a(i,j) + b(i,j)*c(i,j)
end do
end do

2. do j=1,n ! row indexing
do i=1,n
a(i,j) = a(i,j) + b(i,j)*c(i,j)
end do
end do