program tpk(input,output);
var
i : integer;
y : real;
a : array [0..10] of real;
function f ( t : real) : real;
begin
f := sqrt(abs(t)) + 5*t*t*t
end;
begin
for i := 0 to 10 do read(a[i]);
for i := 10 downto 0 do
begin
y := f(a[i]);
if y > 400 then
writeln(i,' TOO LARGE')
else
writeln(i,y);
end;
end;
end.
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
double f (double t)
{
double temp;
temp = sqrt(fabs(t)) + 5*pow(t,3);
return temp;
}
int main()
{
int i;
double y;
double a[11];
for ( i = 0; i <= 10; ++i)
scanf("%lf", &a[i]);
for ( i = 10; i >= 0; i = i - 1 ) {
y = f(a[i]);
if ( y > 400 ) {
printf(" %d",i);
printf(" TOO LARGE\n");
}
else {
printf(" %d",i);
printf(" %lf",y);
printf(" \n");
}
}
return 0;
}
DIMENSION A(11)
READ A
2 DO 3,8,11 J=1,11
3 I=11-J
Y=SQRT(ABS(A(I+1)))+5*A(I+1)**3
IF (400>=Y) 8,4
4 PRINT I,999.
GOTO 2
8 PRINT I,Y
11 STOP
C FORTRAN I STYLE
FUNF(T)=SQRTF(ABSF(T))+5.0*T**3
DIMENSION A(11)
1 FORMAT(6F12.4)
READ 1,A
DO 10 J=1,11
I=11-J
Y=FUNF(A(I+1))
IF(400.0-Y)4,8,8
4 PRINT 5,I
5 FORMAT(I10,10H TOO LARGE)
GOTO 10
8 PRINT 9,I,Y
9 FORMAT(I10,F12.7)
10 CONTINUE
STOP 52525
C FORTRAN IV STYLE
DIMENSION A(11)
FUN(T) = SQRT(ABS(T)) + 5.0*T**3
READ (5,1) A
1 FORMAT(5F10.2)
DO 10 J = 1, 11
I = 11 - J
Y = FUN(A(I+1))
IF (400.0-Y) 4, 8, 8
4 WRITE (6,5) I
5 FORMAT(I10, 10H TOO LARGE)
GO TO 10
8 WRITE(6,9) I, Y
FORMAT(I10, F12.6)
10 CONTINUE
STOP
END
C FORTRAN IV STYLE
DIMENSION A(11)
FUN(T) = SQRT(ABS(T)) + 5.0*T**3
READ (5,1) A
1 FORMAT(5F10.2)
DO 10 J = 1, 11
I = 11 - J
Y = FUN(A(I+1))
IF (400.0-Y) 4, 8, 8
4 WRITE (6,5) I
5 FORMAT(I10, 10H TOO LARGE)
GO TO 10
8 WRITE(6,9) I, Y
FORMAT(I10, F12.6)
10 CONTINUE
STOP
END
PROGRAM TPK
C FORTRAN 77 STYLE
REAL A(0:10)
READ (5,*) A
DO 10 I = 10, 0, -1
Y = FUN(A(I))
IF ( Y .LT. 400) THEN
WRITE(6,9) I, Y
9 FORMAT(I10, F12.6)
ELSE
WRITE (6,5) I
5 FORMAT(I10,' TOO LARGE')
ENDIF
10 CONTINUE
END
REAL FUNCTION FUN(T)
REAL T
FUN = SQRT(ABS(T)) + 5.0*T**3
END
program sample1
integer, parameter :: ap=selected_real_kind(15,300)
real(kind=ap) :: x, y
real(kind=ap) :: k(20,20)
x = 6.0_ap
y = 0.25_ap
write(*,*) x
write(*,*) y
write(*,*) ap
call myproc(k)
write(*,*) k(1,1)
contains
subroutine myproc(k)
integer, parameter :: ap=selected_real_kind(15,300)
real(kind=ap) :: k(20,20)
k=0.0_ap
k(1,1) = 42.0_ap
return
end subroutine myproc
end program sample1
Free form | Fixed form | |
---|---|---|
Source format | Max 132 characters | Code in positions 7-72, line numbers in position 2-5 |
Comments | ! anywhere on a line | !, C or * at position 1 |
Continuation | & at end of line | character at position 6 on continuation line |
Multiple statements / line | ; between statements | On statement per row |
program example
implicit none
integer, parameter :: ap=selected_real_kind(15,300)
real(ap) :: x,y
real(ap) :: K(20,20)
x = 6.0_ap ! This is line comment
y = &
0.25_ap + &
0.25_ap
write(*,*) x; write(*,*) y
write(*,*) ap
call myproc(K)
stop
contains
subroutine myproc(K)
real(ap) :: K(:,:)
K = 0.0_ap
end subroutine
end program example
program program-name]
[specication statements]
[executable statements]
[contains]
[subroutines]
end [program [program-name]]
Source (.f90)
Source (.f90)
Source (.f90)
Object code (.o)
Object code (.o)
Object code (.o)
Executable
Libraries (.so)
$ ml foss/2019a
$ ml
Currently Loaded Modules:
1) GCCcore/8.2.0 8) libpciaccess/0.14
2) binutils/2.31.1 9) hwloc/1.11.11
3) GCC/8.2.0-2.31.1 10) OpenMPI/3.1.3
4) zlib/1.2.11 11) OpenBLAS/0.3.5
5) numactl/2.0.12 12) FFTW/3.3.8
6) XZ/5.2.4 13) ScaLAPACK/2.0.2-OpenBLAS-0.3.5
7) libxml2/2.9.8 14) foss/2019a
$ gfortran --version
GNU Fortran (GCC) 8.2.0
Copyright (C) 2018 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Loading required modules
1a | First char a number |
a thing | Contains a space |
_ | only non-alphanumeric char |
a |
---|
a_thing |
x1 |
mass |
q123 |
time_of_flight |
type [[,attribute]... ::] entity-list
integer :: a ! Scalar integer variable
real :: b ! Scalar floating point variable
logical :: flag ! boolean variable
real :: D(10) ! Floating point array consisting of 10 elements
real :: K(20,20) ! Floating point array of 20x20 elements
integer, dimension(10) :: C ! Integer array of 10 elements
character :: ch ! Character
character, dimension(60) :: chv ! Array of characters
character(len=80) :: line ! Character string
character(len=80) :: lines(60) ! Array of strings
integer, parameter :: A = 5 ! Integer constant
real :: C(A) ! Floating point array where
! the number of elements is
! specified by A
real(8) :: A
real(4) :: B
integer(4) :: I
integer, parameter :: ap = selected_real_kind(15,300)
real(kind=ap) :: X,Y
Using selected_real_kind
explicit precision specifiers
integer, parameter :: ap = selected_real_kind(15,300)
significant decimals
to
! variable declaration with precision specifier
X = 6.2_rk
program constants
implicit none
integer, parameter :: ap = selected_real_kind(15,300)
real(ap) :: pi1, pi2
pi1 = 3.141592653589793
pi2 = 3.141592653589793_ap
write(*,*) 'pi1 = ', pi1
write(*,*) 'pi2 = ', pi2
stop
end program constants
pi1 = 3.14159274101257 pi2 = 3.14159265358979
Variables are assigned with the equal operator (=)
real(rk) | a = 42.0_rk |
integer(ik) | b = 42_ik |
logical | c = .false. d = .true. |
character | first_name = 'Jan' last_name = "Johansson" company_name1 = "McDonald's" company_name2 = 'McDonald''s' |
program derived1
use mf_utils
implicit none
type particle
real(dp) :: x
real(dp) :: y
real(dp) :: z
real(dp) :: m
end type particle
type(particle) :: p
p % x = 0.0_dp
p % y = 1.0_dp
p % z = 2.0_dp
p % m = 3.0_dp
print*, p % x
print*, p % y
print*, p % z
print*, p % m
end program derived1
data type definition
variable declaration
assignment using % operator
accessing values using % operator
program derived2
use mf_utils
implicit none
type data_record
real(dp) :: a
integer :: b
logical :: c
character(10) :: name
end type data_record
type(data_record) :: d
d % a = 0.0_dp
d % b = 1
d % c = .true.
d % name = 'fortran'
print*, d % a
print*, d % b
print*, d % c
print*, d % name
end program derived2
mixed data types
** | power to |
* | multiplication |
/ | division |
+ | addition |
- | subtraction |
c = a+b/2 ! is equivalent to a + (b/2)
c = (a+b)/2 ! in this case (a + b) is evaluated and then /2
< | .lt. | less than |
<= | .le. | less than or equal to |
> | .gt. | greater than |
>= | .ge. | greater than or equal to |
== | .eq. | equal to |
/= | .ne. | not equal to |
.and. | and |
.or. | or |
.not. | not |
Results of divisions will be truncated towards 0
6/3 = 2
8/3 = 2
-8/3 = -2
WARNING
2**3 = 8
2**(-3) = 1/(2**3) = 0
real :: a
integer :: i
real :: b
b = a*i
Coerced to real
real, dimension(10,20) :: a, b
real, dimension(5) :: v
a/b ! Array of shape (10,20), with elements a(i,j)/b(i,j)
v+1. ! Array of shape (5), with elements v(i) + 1.0
5/v+a(1:5,5) ! Array of shape (5), with elements 5/v(i) + a(i,5)
a.eq.b ! .true. if a(i,j)==b(i,j) and .false. otherwise
integer, parameter :: rk = selected_real_kind(15,300)
real(rk), dimension(20,20) :: K ! Matrix 20x20 elements
real(rk) :: Ke(8,8) ! Matrix 8x8 elements
real(rk) :: fe(6) ! Array with 6 elements
! Array with indices
!
! [-3, -2, -1, 0, 1, 2, 3]
real(rk) :: idx(-3:3)
Individual elements
K(5,6) = 5.0
Entire array
K = 5.0
Multiple values in single assignment
real(rk) :: v(5) ! Array with 5 elements
v = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /)
program index_notation
implicit none
real :: A(4,4)
real :: B(4)
real :: C(4)
B = A(2,:) ! Assigns B the values of row 2 in A
C = A(:,1) ! Assigns C the values of column 1 in A
stop
end program index_notation
ex4
! Assign row 5 in matrix K the values 1, 2, 3, 4, 5
K(5,:) = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /)
! Assign the array v the values 5, 4, 3, 2, 1
v = (/ 5.0, 4.0, 3.0, 2.0, 1.0 /)
Using slices rows and columns can be assigned in single statements
real :: A(16)
real :: A(8,2)
real :: A(2,8)
! Assign row 5 in matrix K the values 1, 2, 3, 4, 5
K(5,:) = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /)
! Assign the array v the values 5, 4, 3, 2, 1
v = (/ 5.0, 4.0, 3.0, 2.0, 1.0 /)
program derived2
use mf_utils
implicit none
type data_record
real(dp) :: a
integer :: b
logical :: c
character(10) :: name
end type data_record
type(data_record) :: d(5)
integer :: i
do i=1,5
d(i) % a = 0.0_dp
d(i) % b = i
d(i) % c = .true.
d(i) % name = 'fortran'
end do
do i=1,5
print*, d(i) % b
end do
end program derived2
derived data type array
if (scalar-logical-expr) then
block
end if
if (scalar-logical-expr) statement
if (scalar-logical-expr1) then
block1
else if (scalar-logical-expr2) then
block2
else
block3
end if
program logic
implicit none
integer :: x
logical :: flag
write(*,*) 'Enter an integer value.'
read(*,*) x
flag = .FALSE.
if (x>1000) then
x = 1000
flag = .TRUE.
end if
if (x<0) then
x = 0
flag = .TRUE.
end if
if (flag) then
write(*,'(a,I4)') 'Corrected value = ', x
else
write(*,'(a,I4)') 'Value = ', x
end if
end program logic
select case (expr)
case selector
block
end select
select case (expr)
case selector
block
case default
block
end select
program case_sample
integer :: value
write(*,*) 'Enter a value'
read(*,*) value
select case (value)
case (:0)
write(*,*) 'Greater than one.'
case (1)
write(*,*) 'Number one!'
case (2:9)
write(*,*) 'Between 2 and 9.'
case (10)
write(*,*) 'Number 10!'
case (11:41)
write(*,*) 'Less than 42 but greater than 10.'
case (42)
write(*,*) 'Meaning of life or perhaps 6*7.'
case (43:)
write(*,*) 'Greater than 42.'
case default
write(*,*) 'This should never happen!'
end select
end program case_sample
do i = 1, 10
j = j + i
end do
do i = 2, 30, 4
j = j + i
end do
start-value
end-value
start-value
end-value
step
loop-variable is not allowed to be modified inside a do-statement
ex11
do i=1, 1000
if (i>50) then
exit
else if (i<10) then
cycle
end if
print *,i
end do
Exit do-statement and execute next executable statement after loop.
Continue to next iteration
ex11
10
11
12
.
.
.
47
48
49
50
do while (scalar-logical-expr)
block
end do
Execute until a certain condition is fulfilled
x = 0.0
do while (x<1.05)
f = sin(x)
x = x + 0.1
write(*,*) x, f
end do
0.100000001 0.00000000 0.200000003 9.98334214E-02 0.300000012 0.198669329 0.400000006 0.295520216 0.500000000 0.389418334 0.600000024 0.479425550 0.700000048 0.564642489 0.800000072 0.644217730 0.900000095 0.717356145 1.00000012 0.783326983 1.10000014 0.841471076
ex24
ex23
ex24
ex23
real(rk), dimension(20,20) :: A, B, C
C = A/B ! Division Cij = Aij/Bij
C = sqrt(A) ! Square root Cij = sqrt(Aij)
Functions and operators can be used with arrays.
program function_sample
implicit none
integer, parameter :: rk = selected_real_kind(15,300)
integer :: i, j
real(rk) :: x1, x2, y1, y2, z1, z2
real(rk) :: nx, ny, nz
real(rk) :: L, E, A
real(rk) :: Kel(2,2)
real(rk) :: Ke(6,6)
real(rk) :: G(2,6)
! Initiate scalar values
E = 1.0_rk
A = 1.0_rk
x1 = 0.0_rk
x2 = 1.0_rk
y1 = 0.0_rk
y2 = 1.0_rk
z1 = 0.0_rk
z2 = 1.0_rk
! Calcuate directional cosines
L = sqrt( (x2-x1)**2 + (y2-y1)**2 + (z2-z1)**2 )
nx = (x2-x1)/L
ny = (y2-y1)/L
nz = (z2-z1)/L
! Calucate local stiffness matrix
Kel(1,:) = (/ 1.0_ap , -1.0_ap /)
Kel(2,:) = (/ -1.0_ap, 1.0_ap /)
Kel = Kel * (E*A/L)
G(1,:) = (/ nx, ny, nz, 0.0_ap, 0.0_ap, 0.0_ap /)
G(2,:) = (/ 0.0_ap, 0.0_ap, 0.0_ap, nx, ny, nz /)
! Calculate transformed stiffness matrix
Ke = matmul(matmul(transpose(G),Kel),G)
! Print matrix
do i=1,6
write(*,'(6G10.3)') (Ke(i,j), j=1,6)
end do
end program function_sample
0.1925 0.1925 0.1925 -.1925 -.1925 -.1925 0.1925 0.1925 0.1925 -.1925 -.1925 -.1925 0.1925 0.1925 0.1925 -.1925 -.1925 -.1925 -.1925 -.1925 -.1925 0.1925 0.1925 0.1925 -.1925 -.1925 -.1925 0.1925 0.1925 0.1925 -.1925 -.1925 -.1925 0.1925 0.1925 0.1925
[program program-name]
[specification statements]
[executable statements]
[contains
internal-subprograms]
end [program [program-name]]
The end-statement signals the end of the program-unit and also terminates the program execution
A Fortran program can only have one main program
subroutine subroutine-name[([dummy-argument-list])]
[argument-declaration]
...
return
end subroutine [subroutine-name]
A subroutine in Fortran has the following syntax
subroutine myproc(a,B,C)
implicit none
integer :: a
real, dimension(a,*) :: B
real, dimension(a) :: C
...
return
end subroutine
integer :: a
real, dimension(20,02) :: B
real, dimension(10) :: C
call myproc(a,B,C)
Dimensions of arrays need to be passed in the call, so that they can be declared correctly in the subroutine.
Last dimension not needed to be passed (*) as it is not needed to reference an array.
type function function-name([dummy-argument-list])
[argument-declaration]
...
function-name = return-value
...
return
end function function-name
A subroutine in Fortran has the following syntax
Subroutine with a return value
real function f(x)
real :: x
f = sin(x)
return
end function f
real :: x, y
y = f(x)
module module-name
[specification statements]
[contains
module-subprograms]
end [module [program-name]]
module constants
integer, parameter :: ik6 = selected_int_kind(6)
integer, parameter :: rk = selected_real_kind(15,300)
end module constants
use constants
integer(ik6) :: myint
real(rk) :: myreal
module truss
integer ...
real, private ...
public :: bar2e
contains
subroutine bar2e(...)
...
return
end subroutine bar2e
end module truss
Variables and subroutines can be made private and public (default) using the private and public attributes
program main
use truss
call bar2e(...)
end program main
All public variables, subroutines and datatypes from truss now available in program unit
program sub_declaration1
real(8), dimension(4,4) :: A
integer, dimension(3) :: v
A = 0.0_8
v = 0
call dowork(A,4,4,v,3)
print *, A(4,4)
print *, v(3)
end program sub_declaration1
subroutine dowork(A,rows,cols,v,elements)
integer :: rows, cols, elements
real(8), dimension(rows*cols) :: A
integer, dimension(elements) :: v
A = 42.0_8
v = 42
return
end subroutine dowork
program test
real(8), dimension(20,30) :: A
A = 0.0_8
call mysub(A, 20, 30)
end program test
subroutine mysub(A,rows,cols)
integer :: rows, cols
real(8), dimension(rows,cols) :: A
A = 42.0_8
print *, 'rows = ', size(A,1)
print *, 'cols = ', size(A,2)
return
end subroutine mysub
ex12,13
program test
use utils
real(8), dimension(20,30) :: A
A = 0.0_8
call mysub2(A)
end program test
module utils
contains
subroutine mysub2(A)
real(8), dimension(:,:) :: A
A = 42.0_8
print *, 'rows = ', size(A,1)
print *, 'cols = ', size(A,2)
return
end subroutine mysub2
end module utils
Assumed shape array
ex14
program test
real(8), dimension(20,30) :: A
A = 0.0_8
call mysub3(A)
contains
subroutine mysub3(A)
real(8), dimension(:,:) :: A
A = 42.0_8
print *, 'rows = ', size(A,1)
print *, 'cols = ', size(A,2)
end subroutine mysub3
end program test
Assumed shape array
As no module or program unit is used interface must be declared explicitely here
program test
interface
subroutine mysub4(A)
real(8), dimension(:,:) :: A
end subroutine mysub4
end interface
real(8), dimension(20,30) :: A
A = 0.0_8
call mysub4(A)
end program test
subroutine mysub4(A)
real(8), dimension(:,:) :: A
A = 42.0_8
print *, 'rows = ', size(A,1)
print *, 'cols = ', size(A,2)
return
end subroutine mysub4
ex16
program automatic_arrays
real(8), dimension(20,30) :: A
call mysub(A)
contains
subroutine mysub(A)
real(8), dimension(:,:) :: A
integer, dimension(size(A,1),size(A,2)) :: B
B = 0
print *, "rows = ", size(B,1)
print *, "cols = ", size(B,2)
end subroutine mysub
end program automatic_arrays
B is automatically allocated. size() can be used to query size. More on this later.
real, dimension(:), allocatable :: f
real, dimension(:,:), allocatable :: K
allocate(f(20)) ! or allocate(f(20), K(20,20)
allocate(K(20,20))
deallocate(f) ! or deallocate(f, K)
deallocate(K)
ex18
program array_subobjects
integer, dimension(5,10) :: A
integer :: i, j
do i=1,5
do j=1,10
A(i,j) = (i-1)*10 + j
end do
end do
print *, "Entire array:"
call writeArray(A)
print *, "A(1, 5:10)"
call writeVector(A(1, 5:10))
print *, "A(1:5, 5:10)"
call writeArray(A(1:5, 5:10))
print *, "A(1:5, 5:10)"
call writeArray(A(1:5, 5:10))
print *, "A((/1,3/), (/2,4/))"
call writeArray(A( (/1,3/), (/2,4/) ))
end program array_subobjects
ex22
Entire array:
1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
31 32 33 34 35 36 37 38 39 40
41 42 43 44 45 46 47 48 49 50
A(1, 5:10)
5 6 7 8 9 10
A(1:5, 5:10)
5 6 7 8 9 10
15 16 17 18 19 20
25 26 27 28 29 30
35 36 37 38 39 40
45 46 47 48 49 50
A(1:5, 5:10)
5 6 7 8 9 10
15 16 17 18 19 20
25 26 27 28 29 30
35 36 37 38 39 40
45 46 47 48 49 50
A((/1,3/), (/2,4/))
2 4
22 24
ex24
program matrix_multiply
real(8), dimension(4,4) :: A
real(8), dimension(4,8) :: B
real(8), dimension(4,8) :: C
call randomMatrix(A)
call randomMatrix(B)
call randomMatrix(C)
C = matmul(A,B)
print *, "A = "
call writeArray(A)
print *, "B = "
call writeArray(B)
print *, "C = "
call writeArray(C)
end program matrix_multiply
A =
.984 .700 .275 .661
.810 .910 .304 .484
.985 .347 .548 .614
.971 .882 .129 .929
B =
.763 .534 .711E-01.404 .731 .636 .879 .689
.786 .231 .238 .951 .621 .528 .733 .588E-01
.466 .302 .209 .294 .598 .461 .911 .343
.690E-01.619 .305 .326E-01.438 .202 .617 .851
C =
1.48 1.18 .496 1.17 1.61 1.26 2.04 1.38
1.51 1.03 .486 1.30 1.55 1.23 1.96 1.13
1.32 1.15 .455 .909 1.53 1.19 2.00 1.41
1.56 1.34 .589 1.30 1.74 1.33 2.19 1.56
ex25
print *, 'Product of A = ', product(A)
print *, 'Sum of A = ', sum(A)
print *, 'Max of A = ', maxval(A)
print *, 'Min of A = ', minval(A)
A =
.984 .700 .275 .661
.810 .910 .304 .484
.985 .347 .548 .614
.971 .882 .129 .929
Product of A = 0.00016095765496870103
Sum of A = 10.534961942117661
Max of A = 0.9853920286986977
Min of A = 0.12899155798368156
ex26
! Read 8 floating point values from unit ir
read(*,*) a(1), a(2), a(3), a(4), a(5), a(6), a(7), a(8)
! or perhaps even better...
read(*,*) (a(i), i=1,8)
! Same procedure for writing
write(*,*) (a(i), i=1,8)
For only writing to standard output, the print-statement can be used.
print*, 'Hello, world!'
ex27
program format_print
real(8), dimension(3) :: a
integer, dimension(4) :: b
integer :: i, j
! Write table header
a = (/ 1.0, 2.0, 3.0 /)
b = (/ 4, 5, 6, 7 /)
write(*, '(3A8,4A5)') 'aaaaaaaa', &
'bbbbbbbb', 'cccccccc', 'ddddd', 'eeeee', 'fffff', &
'ggggg‘
! Write table
do j=1,10
write(*, '(3G8.3,4I5)') (a(i),i=1,3), (b(i), i=1,4)
end do
end program format_print
ex28
aaaaaaaabbbbbbbbccccccccdddddeeeeefffffggggg
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
1.00 2.00 3.00 4 5 6 7
subroutine writeArray(A)
real(8), dimension(:,:) :: A
integer :: rows, cols, i, j
character(255) :: fmt
rows = size(A,1)
cols = size(A,2)
write(fmt, '(A,I1,A)') '(',cols, 'G8.3)'
do i=1,rows
print fmt, (A(i,j), j=1,cols)
end do
return
end subroutine writeArray
String that will contain the final format code.
Write to fmt string using a write statement
Use the format string when printing array
ex29
integer, parameter :: infile = 15
integer, parameter :: outfile = 16
! ---- Open a file for reading
open(unit=infile,file='indata.dat', access='sequential', action='read')
! ---- Read from file
read(infile, *) ...
! ---- Close file
close(infile)
! ---- Open a file for writing
open(unit=outfile,file='utdata.dat', access='sequential', action='write')
! ---- Write to file
write(outfile, *) ...
! ---- Close file
close(outfile)
Texfile mode
File operation
Filename
read(*,*) A
read(5,*) A
integer, parameter :: ir=15
open(unit=ir, file=’example.dat’)
read(ir,*) A
close(unit=ir)
Keyboard
File
write(*,*) A
write(6,*) A
write(*,’ (TR1,A,G15.6)’) ’A = ’, A
integer, parameter :: iw=16
open(unit=iw, file=’example.dat’)
write(iw, ’(A,G15.6)’) A
close(unit=iw)
Keyboard
File
program stress
use inputdata
use outputdata
use fem
use solve
.
.
end program stress
module fem
use utils
.
.
end module fem
module utils
.
.
end module utils
module utils
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
contains
real(dp) function myfunc(x)
real(dp), intent(in) :: x
myfunc = sin(x)
end function myfunc
subroutine tabulate(startInterval, endInterval, step, func)
real(dp), intent(in) :: startInterval, endInterval, step
real(dp) :: x
interface
real(8) function func(x)
real(8), intent(in) :: x
end function func
end interface
x = startInterval
do while (x<endInterval)
print *, x, func(x)
x = x + step
end do
return
end subroutine tabulate
end module utils
Declaration of function interface. Function used as argument must have the same interface
program procedures_as_arguments
use utils
implicit none
call tabulate(0.0_dp, 3.14_dp, 0.1_dp, myfunc)
end program procedures_as_arguments
0.0000000000000000 0.0000000000000000
0.10000000000000001 9.98334166468281548E-002
0.20000000000000001 0.19866933079506122
0.30000000000000004 0.29552020666133960
0.40000000000000002 0.38941834230865052
0.50000000000000000 0.47942553860420301
0.59999999999999998 0.56464247339503537
0.69999999999999996 0.64421768723769102
0.79999999999999993 0.71735609089952268
0.89999999999999991 0.78332690962748330
0.99999999999999989 0.84147098480789639
1.0999999999999999 0.89120736006143531
1.2000000000000000 0.93203908596722629
1.3000000000000000 0.96355818541719296
1.4000000000000001 0.98544972998846025
1.5000000000000002 0.99749498660405445
1.6000000000000003 0.99957360304150511
1.7000000000000004 0.99166481045246857
1.8000000000000005 0.97384763087819504
1.9000000000000006 0.94630008768741425
2.0000000000000004 0.90929742682568149
2.1000000000000005 0.86320936664887349
2.2000000000000006 0.80849640381958987
2.3000000000000007 0.74570521217671970
2.4000000000000008 0.67546318055115029
2.5000000000000009 0.59847214410395577
2.6000000000000010 0.51550137182146338
2.7000000000000011 0.42737988023382895
...
call order_icecream(2)
call order_icecream(2, 1)
call order_icecream(4, 4, 2)
call order_icecream(4, topping=3)
subroutine order_icecream(number, flavor, topping)
integer :: number
integer, optional :: flavor
integer, optional :: topping
print *, number, 'icecreams ordered.'
if (present(flavor)) then
print *, 'Flavor is ', flavor
else
print *, 'No flavor was given.'
end if
if (present(topping)) then
print *, 'Topping is ', topping
else
print *, 'No topping was given.'
end if
end subroutine order_icecream
module special
interface func
module procedure ifunc, rfunc
end interface
contains
integer function ifunc(x)
integer, intent(in) :: x
ifunc = x * 42
end function ifunc
real(dp) function rfunc(x)
real(dp), intent(in) :: x
rfunc = x / 42.0_dp
end function rfunc
end module special
program overloading
use special
implicit none
integer :: a = 42
real(dp) :: b = 42.0_dp
a = func(a)
b = func(b)
print *, a
print *, b
end program overloading
1764
1.00000000000000000
module vector_operations
integer, parameter :: dp = selected_real_kind(15,300)
type vector
real(dp) :: components(3)
end type vector
interface operator(+)
module procedure vector_plus_vector
end interface
contains
type(vector) function vector_plus_vector(v1, v2)
type(vector), intent(in) :: v1, v2
vector_plus_vector%components = v1 % components + v2 % components
end function vector_plus_vector
end module vector_operations
program operator_overloading
use vector_operations
implicit none
type(vector) :: v1
type(vector) :: v2
type(vector) :: v
v1 % components = (/1.0, 0.0, 0.0/)
v2 %components = (/0.0, 1.0, 0.0/)
v = v1 + v2
print *, v
end program operator_overloading
1.00000000000000000 1.00000000000000000 0.0000000000000000
module mymodule
implicit none
integer, public :: visible
integer, private :: invisible
private privatefunc
public publicfunc
contains
subroutine privatefunc
print *, 'This function can only be called from within a module.'
end subroutine privatefunc
subroutine publicfunc
call privatefunc
end subroutine publicfunc
end module mymodule
program private_entities
use mymodule
implicit none
call publicfunc
end program private_entities
program private_entities
use mymodule
implicit none
call privatefunc
end program private_entities
Works as publicfunc is public
make all
gfortran -g -fbounds-check -Wall -Wtabs -c main.f90
gfortran -o private_entities mymodule.o main.o
main.o: In function `private_entities':
D:\edu\.../main.f90:7: undefined reference to `privatefunc_'
collect2: ld returned 1 exit status
make: *** [private_entities] Error 1
Doesn't work as privatefunc is private
program pointers
implicit none
integer, allocatable, dimension(:,:), target :: A
integer, dimension(:,:), pointer :: B, C
allocate(A(20,20))
B => A
print *, size(B,1), size(B,2)
call createArray(C)
print *, size(C,1), size(C,2)
deallocate(C)
B => null()
B(1,1) = 0 ! Dangerous!
contains
subroutine createArray(D)
integer, dimension(:,:), pointer :: D
allocate(D(10,10))
end subroutine createArray
end program pointers
B points to A
B can be queried just like a normal array
An unassociated pointer can be passed to a subroutine and be returned as an allocated array
program list_io
implicit none
integer, parameter :: ir = 15
integer, parameter :: iw = 16
integer :: a = 42
real :: b = 42.0 * 42.0
character(len=20) :: string = 'Hello, string!'
logical :: topping = .true.
complex :: c = (1.0,2.0)
open(unit=iw, file='list.txt', status='replace')
write(iw,*) a, b, '"',string,'"', topping, c
close(unit=iw)
open(unit=ir, file='list.txt', status='old')
read(ir,*) a, b, string, topping, c
close(unit=ir)
print *, a
print *, b
print *, topping
print *, c
end program list_io
42 1764.0000 "Hello, string! " F ( 1.00000000 , 2.0000000 )
.true. and .false. can also be used as input for logical variables
program namelist_io
implicit none
integer, parameter :: ir = 15
integer, parameter :: iw = 16
integer :: no_of_eggs, litres_of_milk, kilos_of_butter, list(5)
namelist /food/ no_of_eggs, litres_of_milk, kilos_of_butter, list
list = 0
open(unit=ir, file='food.txt', status='old')
read(ir, nml=food)
close(unit=ir)
print *, no_of_eggs, litres_of_milk, kilos_of_butter
open(unit=iw, file='food2.txt', status='new')
write(iw, nml=food)
close(unit=iw)
end program namelist_io
namelist defined variables to be read from file
namelist defined variables to be written to file.
program unformatted_io
implicit none
type account
character(len=40) :: account_holder
real :: balance
end type account
integer, parameter :: iw = 15
type(account) :: accountA
type(account) :: accountB
integer :: recordSize
inquire(iolength=recordSize) accountA
print *, 'Record size =',recordSize
accountA % account_holder = 'Olle'
accountA % balance = 400
accountB % account_holder = 'Janne'
accountB % balance = 800
open(unit=iw, file='bank.dat', access='direct', recl=recordSize, status='replace')
write(iw, rec=1) accountA
write(iw, rec=2) accountB
close(unit=iw)
end program unformatted_io
Derived datatypes good candidates for storing as records in a random access file
Inquire for the required record length
access=’direct’ creates a direct access file.
The rec attribute determines the location to store/read the record
program error_handling
implicit none
integer, parameter :: ir = 15
integer :: a
open(unit=ir, file='test.txt', status='old', err=99)
read(ir,*,err=99) a
close(unit=ir,err=99)
stop
99 print *, 'An error occured reading the file.'
end program error_handling
program allocatable_dummy
implicit none
real, allocatable :: A(:,:)
call createArray(A)
print *, size(A,1), size(A,2)
deallocate(A)
contains
subroutine createArray(A)
real, allocatable, intent(out) :: A(:,:)
allocate(A(20,20))
end subroutine createArray
end program allocatable_dummy
A pointer dummy argument was needed to implement this i Fortran 95
program allocatable_function
implicit none
real :: A(20)
A = createVector(20)
print *, size(A,1)
contains
function createVector(n)
real, allocatable, dimension(:) :: createVector
integer, intent(in) :: n
allocate(createVector(n))
end function createVector
end program allocatable_function
Vector allocated in function will be automatically deallocated when it has been used.
type stack
integer :: index
integer, allocatable :: content(:)
end type stack
Pointers used in Fortran 95, but no automatic deallocation available
Separation of module into
Interface – defined in the module
Body – defined in submodule
module points
type point
real :: x, y
end type point
interface
real module function point_dist(a, b)
type(point), intent(in) :: a, b
end function point_dist
end interface
end module points
submodule (points) points_a
contains
real module function point_dist(a,b)
type(point), intent(in) :: a, b
point_dist = sqrt((a%x-b%x)**2+(a%y-b%y)**2)
end function point_dist
end submodule points_a
program c_interop
use iso_c_binding
implicit none
integer(c_int) :: a
real(c_float) :: b
real(c_double) :: c
a = 42
b = 42.0_c_float
c = 84.0_c_double
print *, a, b, c
end program c_interop
module mytype_module
type mytype
real :: myvalue(4) = 0.0
contains
procedure :: write => write_mytype
procedure :: reset
end type mytype
private :: write_mytype, reset
contains
subroutine write_mytype(this, unit)
class(mytype) :: this
integer, optional :: unit
if (present(unit)) then
write(unit,*) this % myvalue
else
print *, this % myvalue
end if
end subroutine write_mytype
subroutine reset(variable)
class(mytype) :: variable
variable % myvalue = 0.0
end subroutine reset
end module mytype_module
class(mtype) :: x
call x % write(6)
call x % reset