Skip to content
Extraits de code Groupes Projets
Valider 21561c5f rédigé par PY Barriat's avatar PY Barriat
Parcourir les fichiers

Updates for 2024

parent 6ebd28ad
Branches master
Aucune étiquette associée trouvée
Aucune requête de fusion associée trouvée
......@@ -37,7 +37,7 @@ https://forge.uclouvain.be/barriat/learning-fortran
---
# Why to learn Fortran ?
# Why learn Fortran ?
* Because of the execution `speed` of a program
* Well suited for numerical computations :
......@@ -96,13 +96,13 @@ more than 45% of scientific applications are in Fortran
---
# How to Build a FORTRAN Program
# How to build a FORTRAN program
FORTRAN is a compiled language (like C) so the source code (what you write) must be converted into machine code before it can be executed (e.g. Make command)
![h:350](assets/build_fortran.png)
> Fortran 77 source code [hello_world.f](https://gogs.elic.ucl.ac.be/pbarriat/learning-fortran/src/master/src/00_hello_world.f)
> Fortran 77 source code [hello_world.f90](https://gogs.elic.ucl.ac.be/pbarriat/learning-fortran/src/master/src/00_hello_world.f90)
---
......@@ -132,7 +132,7 @@ Versions >90 relaxe these requirements:
---
# Program Organization
# Program organization
Most `FORTRAN` programs consist of a main program and one or more subprograms
......@@ -151,7 +151,7 @@ Subprogram definitions
---
# Data Type Declarations
# Data type declarations
Basic data types are :
......@@ -159,66 +159,114 @@ Basic data types are :
- `REAL` : floating point numbers
- `DOUBLE PRECISION` : extended precision floating point
- `CHARACTER*n` : string with up to **n** characters
> `character(len=n)`
- `LOGICAL` : takes on values `.TRUE.` or `.FALSE.`
---
# Data Type Declarations
`INTEGER` and `REAL` can specify number of bytes to use
> Default is: `INTEGER*4` and `REAL*4`
`DOUBLE PRECISION` is same as `REAL*8`
> or `REAL(8)`
```Fortran
program variables_example
integer :: a = 5
real :: b = 3.14
character(len=10) :: name = "Fortran"
logical :: is_programming_fun = .true.
end program variables_example
```
---
- Default is: `INTEGER*4` and `REAL*4`
- `DOUBLE PRECISION` is same as `REAL*8`
# Arrays
Arrays of any type must be declared:
Arrays of any type must be declared with the `dimension` attribute in **F77**
- `DIMENSION A(3,5)` - declares a 3 x 5 array
- `CHARACTER*30 NAME(50)` - directly declares a `character` array with 30 `character` strings in each element
```Fortran
! declare and initialize a vector
integer, dimension(5) :: nums = (/1, 2, 3, 4, 5/)
! declare a 3 x 5 array
real, dimension nums(3,5)
! declare a vector with 30 characters strings in each element
character(30), dimension name(50)
```
In **>F90**, you *can* remove the `dimension` attribute
```Fortran
! declare a 3 x 5 array
real nums(3,5)
```
---
# Implicit vs Explicit Declarations
Arrays can be multi-dimensional (up to 7 in F77) and are indexed using `( )`
By default, an implicit type is assumed depending on the first letter of the variable name:
> `my_array(3)` or `force(4,2)`
- `A-H, O-Z` define REAL variables
- `I-N` define INTEGER variables
Indices are by default defined as `1...N`
Can use the IMPLICIT statement:
We can specify index range in declaration
```fortran
IMPLICIT REAL (A-Z)
```
> `INTEGER arr(0:11)` : `arr` is dimensioned from `0-11` (12 elements)
> makes all variables REAL if not declared
Whole array reference (only in >F90): `arr(:)=-8` assigns 8 to all elements in `arr`
> Avoid `arr=-8` assignement
---
# Implicit vs Explicit Declarations
Arrays are stored in column order (1st column, 2nd column, etc) so accessing by **incrementing row index first** usually is **fastest**
```fortran
IMPLICIT CHARACTER*2 (W)
real, dimension(1000, 1000) matrix
do j = 1, 1000 ! Column loop (outer loop)
do i = 1, 1000 ! Row loop (inner loop)
matrix(i, j) = matrix(i, j) * 2.0
end do
end do
```
> makes variables starting with W be 2-character strings
> **column major** ordering in Fortran vs. **row major** ordering in C
A compiler (with sufficient optimization flags) may re-order loops automatically
---
# Implicit vs Explicit declarations
By default, an implicit type is assumed depending on the first letter of the variable name:
- `A-H, O-Z` define REAL variables
- `I-N` define INTEGER variables
Can use the IMPLICIT statement:
```fortran
IMPLICIT DOUBLE PRECISION (D)
IMPLICIT REAL (A-Z)
```
> makes variables starting with D be double precision
> makes all variables REAL if not declared
---
**Good habit**: force explicit type declarations
## Good habit
Force explicit type declarations :
```fortran
IMPLICIT NONE
```
> user must explicitly declare all variable types
User must explicitly declare all variable types
---
# Assignment Statements
# Assignment statements
**Old** assignment statement: `<label>` `<variable>` = `<expression>`
......@@ -228,14 +276,14 @@ IMPLICIT NONE
**Expression**:
- Numeric expressions: `VAR = 3.5*COS(THETA)`
- Character expressions: `DAY(1:3) = 'TUE'`
- Relational expressions: `FLAG = ANS .GT. 0`
- Logical expressions: `FLAG = F1 .OR. F2`
- Numeric expressions: `var = 3.5*cos(theta)`
- Character expressions: `day(1:3) = 'TUE'`
- Relational expressions: `flag = ans .GT. 0`
- Logical expressions: `flag = F1 .OR. F2`
---
# Numeric Expressions
# Numeric expressions
Arithmetic operators: precedence: `**` *(high)*`-` *(low)*
......@@ -249,8 +297,6 @@ Arithmetic operators: precedence: `**` *(high)* → `-` *(low)*
---
# Numeric Expressions
Numeric expressions are up-cast to the highest data type in the expression according to the precedence:
*(low)* logical → integer → real → complex *(high)*
......@@ -259,12 +305,12 @@ and smaller byte size *(low)* to larger byte size *(high)*
## Examples:
> Fortran 77 source code [01_arith.f](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/01_arith.f)
> Fortran 77 source code [02_sphere.f](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/02_sphere.f)
> Fortran source code [01_arith.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/01_arith.f90)
> Fortran source code [02_sphere.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/02_sphere.f90)
---
# Character Expressions
# Character expressions
Only built-in operator is **Concatenation** defined by `//`
......@@ -279,8 +325,6 @@ Only built-in operator is **Concatenation** defined by `//`
---
# Character Expressions
Example:
```fortran
......@@ -302,7 +346,7 @@ GEORGE BURDELL
---
# Relational Expressions
# Relational expressions
Two expressions whose values are compared to determine whether the relation is true or false
......@@ -315,8 +359,6 @@ Two expressions whose values are compared to determine whether the relation is t
---
# Relational Expressions
| Operator | Relationship |
| ------------ | --------------- |
| `.LT.` or `<` | less than |
......@@ -328,7 +370,7 @@ Two expressions whose values are compared to determine whether the relation is t
---
# Logical Expressions
# Logical expressions
Consists of one or more logical operators and logical, numeric or relational operands
......@@ -339,8 +381,6 @@ Consists of one or more logical operators and logical, numeric or relational ope
---
# Logical Expressions
| F77 Operator | >F90 Operator | Example | Meaning |
| --------------- | --------------- | ------------ | --------------- |
| `.AND.` | `&&` | `A .AND. B` | logical `AND` |
......@@ -352,29 +392,7 @@ Consists of one or more logical operators and logical, numeric or relational ope
---
# Arrays in FORTRAN
Arrays can be multi-dimensional (up to 7 in F77) and are indexed using `( )`:
- `TEST(3)` or `FORCE(4,2)`
> Indices are by default defined as `1...N`
We can specify index range in declaration
- `INTEGER K(0:11)` : `K` is dimensioned from `0-11` (12 elements)
Arrays are stored in column order (1st column, 2nd column, etc) so accessing by **incrementing row index first** usually is **fastest** (see later)
Whole array reference (only in >F90): `K(:)=-8` assigns 8 to all elements in K
> Avoid `K=-8` assignement
---
# Unconditional `GO TO` in F77
This is the only GOTO in FORTRAN 77
# Unconditional `GO TO` in FORTRAN 77
- Syntax: `GO TO label`
- Unconditional transfer to labeled statement
......@@ -392,7 +410,23 @@ This is the only GOTO in FORTRAN 77
---
# `IF ELSE IF` Statement
# Spaghetti Code in F77 (and before)
Use of `GO TO` and arithmetic `IF`'s leads to bad code that is very hard to maintain
```fortran
10 IF (KEY.LT.0) GO TO 20
TEST=TEST-1
THETA=ATAN(X,Y)
GO TO 30
20 TEST=TEST+1
THETA=ATAN(-X,Y)
30 CONTINUE
```
---
# `IF ELSE IF` statement
Basic version:
......@@ -412,44 +446,24 @@ ENDIF
---
# Spaghetti Code in F77 (and before)
Use of `GO TO` and arithmetic `IF`'s leads to bad code that is very hard to maintain
Here is the equivalent of an `IF-THEN-ELSE` statement:
```fortran
10 IF (KEY.LT.0) GO TO 20
TEST=TEST-1
THETA=ATAN(X,Y)
GO TO 30
20 TEST=TEST+1
THETA=ATAN(-X,Y)
30 CONTINUE
```
Now try to figure out what a complex `IF ELSE IF` statement would look like coded with this kind of simple `IF`...
---
# Loop Statements (old versions)
# Loop statements (old versions)
`DO` loop: structure that executes a specified number of times
*Spaghetti Code Version*
```fortran
K=2
K=1
10 PRINT*,A(K)
K=K+2
IF (K.LE.11) GO TO 10
K=K+1
IF (K.LE.10) GO TO 10
20 CONTINUE
```
*F77 Version*
*Fortran 77 Version*
```fortran
DO 100 K=2,10,2
DO 100 K=1,10
PRINT*,A(K)
100 CONTINUE
```
......@@ -459,23 +473,22 @@ Now try to figure out what a complex `IF ELSE IF` statement would look like code
# Loop Statements (>F90)
```fortran
DO K=2,10,2
DO K=1,10
WRITE(*,*) A(K)
END DO
```
- `loop_control` can include variables and a third parameter to specify increments, including negative values
- loop always executes ONCE before testing for end condition
> can include a third parameter to specify increments, including negative values
```fortran
READ(*,*) R
R=10
DO WHILE (R.GE.0)
VOL=2*PI*R**2*CLEN
READ(*,*) R
VOL=2*PI*R**2
R=R-1
END DO
```
- Loop will not execute at all if `logical_expr` is not true at start
> loop will not execute at all if `logical_expr` is not true at start
---
......@@ -495,7 +508,7 @@ END DO
---
# File-Directed Input and Output
# File I/O
Much of early FORTRAN was devoted to reading input data from "cards" and writing to a line printer
......@@ -509,50 +522,43 @@ Today, most I/O is to and from a file: it requires more extensive I/O capabiliti
---
# `READ` Statement
```Fortran
program io_example
Syntax: `READ(dev_no, format_label) variable_list`
integer file_id = 105
character(len=*) file_name = "data.txt"
```fortran
READ(105,1000) A,B,C
1000 FORMAT(3F12.4)
open(unit=file_id, file=file_name)
write(file_id,*) "Hello, file!"
close(file_id)
end
```
Device number `*` is by default the screen (or *standard output* - also 6)
> device numbers 1-7 are defined as standard I/O devices
- each `READ` reads one line of data
> any remaining data in a line is dropped if not translated in `variable_list`
- `variable_list` can include implied `DO` such as :
`READ(105,1000)(A(I),I=1,10)`
---
# `READ` Statement - cont'd
- input items can be integer, real or character
- characters must be enclosed in `' '` (or `" "`)
- input items are separated by commas
- input items must agree in type with variables in `variable_list`
- each `READ` processes a new record (line)
# `FORMAT` statement
```fortran
INTEGER K
REAL(8) A,B
! reads one line and look for floating point values for A & B and an integer for K
OPEN(105,FILE='path_to_existing_file')
READ(105,*) A,B,K
```
| data type | format descriptors | example |
| --------------- | --------------- | ------------ |
| `integer` | `iw` | `write(*,'(i5)') int` |
| `real` (*decimal*) | `fw.d` | `write(*,'(f7.4)') x` |
| `real` (*exponential*) | `ew.d` | `write(*,'(e12.3)') y` |
| `character` | `a, aw` | `write(*,'(a)') string` |
| `logical` | `lw` | `write(*,'(l2)') test` |
| spaces & tabs | `wx` & `tw` | `write (*,'(i3,2x,f6.3)') i, x` |
| linebreak | `/` | `write (*,'(f6.3,/,f6.3)') x, y` |
---
# `WRITE` Statement
Syntax: `WRITE(dev_no, format_label) variable_list`
# `WRITE` statement
```fortran
WRITE(*,1000) A,B,KEY
1000 FORMAT(F12.4,E14.5,I6)
WRITE(*,1000) A,B,KEY
1000 FORMAT(F12.4,E14.5,I6)
```
```fortran
......@@ -560,29 +566,45 @@ Syntax: `WRITE(dev_no, format_label) variable_list`
1234.5678 -0.12345E+02 12
```
- device number `*` is by default the screen (or *standard output* - also 6)
- each `WRITE` produces one or more output lines as needed to write out `variable_list` using `format` statement
- `variable_list` can include implied `DO`
Each `WRITE` produces one or more output lines as needed to write out `variable_list` using `format` statement
`variable_list` can include implied `DO`
> `write(105,1000) (A(I),I=1,10)`
---
# `FORMAT` Statement
# `READ` statement
| data type | format descriptors | example |
| --------------- | --------------- | ------------ |
| `integer` | `iw` | `write(*,'(i5)') int` |
| `real` (*decimal*) | `fw.d` | `write(*,'(f7.4)') x` |
| `real` (*exponential*) | `ew.d` | `write(*,'(e12.3)') y` |
| `character` | `a, aw` | `write(*,'(a)') string` |
| `logical` | `lw` | `write(*,'(l2)') test` |
| spaces & tabs | `wx` & `tw` | `write (*,'(i3,2x,f6.3)') i, x` |
| linebreak | `/` | `write (*,'(f6.3,/,f6.3)') x, y` |
```fortran
READ(105,1000) A,B,C
1000 FORMAT(3F12.4)
```
Each `READ` reads one line of data
> any remaining data in a line is dropped if not translated in `variable_list`
`variable_list` can include implied `DO`
> `read(105,1000) (A(I),I=1,10)`
---
# `OPEN` & `CLOSE` example (>F90)
- input items can be integer, real or character
- characters must be enclosed in `' '` (or `" "`)
- input items are separated by commas
- input items must agree in type with variables in `variable_list`
Once opened, file is referred to by an assigned device number (a unique id)
- each `READ/WRITE` processes a new record (line)
## Example
Fortran 90 source code [04_plot.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/04_plot.f90)
---
# Advanced example (>F90)
```fortran
character(len=*) :: x_name
......@@ -606,16 +628,6 @@ endif
---
# Examples
Fortran 77 source code [03_histogram.f](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/03_histogram.f)
Fortran 90 source code [03_histogram.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/03_histogram.f90)
Fortran 90 source code [04_plot.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/04_plot.f90)
---
# `NAMELIST`
It is possible to pre-define the structure of input and output data using `NAMELIST` in order to make it easier to process with `READ` and `WRITE` statements
......@@ -645,15 +657,15 @@ On input, the `NAMELIST` data must be structured as follows:
---
# Internal `WRITE` Statement
# Internal `WRITE` statement
Internal `WRITE` does same as `ENCODE` in F77 : **a cast to string**
```fortran
INTEGER*4 J,K
CHARACTER*50 CHAR50
DATA J,K/1,2/
...
INTEGER J,K
CHARACTER(50) CHAR50
J=1
K=2
WRITE(CHAR50,*) J,K
```
......@@ -665,16 +677,17 @@ CHAR50=' 1 2'
---
# Internal `READ` Statement
# Internal `READ` statement
Internal `READ` does same as `DECODE` in F77 : **a cast from string**
```fortran
INTEGER K
REAL A,B
CHARACTER*80 REC80
DATA REC80/'1.2, 2.3, -5'/
...
CHARACTER(80) REC80
REC80(1)='1.2'
REC80(2)='2.3'
REC80(3)='-5'
READ(REC80,*) A,B,K
```
......@@ -712,18 +725,15 @@ Subprograms allow **structured coding**
* Subprograms use a separate namespace (variables are local)
* Variables stored in `COMMON` may be shared between namespaces
---
# Functions and Subroutines - cont'd
Subprograms must (should) include at least one `RETURN`
Subprograms should (must) include at least one `RETURN`
`FUNCTION` example:
```fortran
REAL FUNCTION AVG3(A,B,C)
REAL A,B,C
AVG3=(A+B+C)/3
RETURN
END
......@@ -739,14 +749,12 @@ AV = WEIGHT*AVG3(A1,F2,B2)
---
# Functions and Subroutines - cont'd
Subroutine is invoked using the `CALL` statement
```fortran
SUBROUTINE AVG3S(A,B,C,AVERAGE)
REAL A,B,C, AVERAGE
AVERAGE=(A+B+C)/3
RETURN
END
```
......@@ -780,8 +788,6 @@ CALL AVG3S(A1,3.4,C1,QAV)
---
# Arguments - cont'd
Arguments used in invocation (by calling program) may be *variables*, *array names*, *literals*, *expressions* or *function names*
Using symbolic arguments (variables or array names) is the **only way** to return a value (result) from a `SUBROUTINE`
......@@ -791,8 +797,6 @@ It is considered **BAD coding practice**, but functions can return values by cha
---
# Arguments - cont'd
The `INTENT` keyword (>F90) increases readability and enables better compile-time error checking
```fortran
......@@ -837,6 +841,14 @@ END
---
# Examples
Fortran 77 source code [03_histogram.f](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/03_histogram.f)
Fortran 90 source code [03_histogram.f90](https://forge.uclouvain.be/barriat/learning-fortran/-/blob/master/src/03_histogram.f90)
---
# Arrays with Subprograms
Arrays must be passed by reference to subprogram
......@@ -851,22 +863,6 @@ How do you tell subprogram how large the array is ?
---
# Data layout in multi-dimensional arrays
- always increment the left-most index of multi-dimensional arrays in the innermost loop (i.e. fastest)
- **column major** ordering in Fortran vs. **row major** ordering in C
- a compiler (with sufficient optimization flags) may re-order loops automatically
```fortran
do j=1,M
do i=1,N ! innermost loop
y(i) = y(i)+ a(i,j)*x(j) ! left-most index is i
end do
end do
```
---
# Arrays - dynamic allocation
Using `ALLOCATABLE` on declaration, and using `ALLOCATE` and `DEALLOCATE` later
......@@ -912,6 +908,7 @@ Text file [08_ChristmasTree.txt](https://forge.uclouvain.be/barriat/learning-for
---
<!--
# Modular programming (>F90)
Modular programming is about separating parts of programs into independent and interchangeable modules :
......@@ -925,6 +922,7 @@ Modular programming is about separating parts of programs into independent and i
The principle is that making significant parts of the code independent, replaceable and independently testable makes your programs **more maintainable**
---
-->
# Data Type Declarations
......
Aucun aperçu pour ce type de fichier
......@@ -18,9 +18,9 @@ C
OPEN( 10, FILE = '03_histogram.data', STATUS = 'OLD', ERR = 900 )
OPEN( 20, FILE = '03_histogram.out' )
DO 110 I = 1,MAXDATA
DO I = 1,MAXDATA
READ( 10, *, END = 120, ERR = 900 ) HISTO_DATA(I)
110 CONTINUE
END DO
120 CONTINUE
CLOSE( 10 )
......@@ -32,8 +32,7 @@ C
C File not found, and other errors
900 CONTINUE
WRITE( *, * ) 'File histogram.data could not be opened or some rea
&ding error'
WRITE( *, * ) 'File could not be opened or some reading error'
END
......@@ -46,15 +45,15 @@ C
INTEGER I, J, NOHIST
DO 120 I = 1,NOBND
DO I = 1,NOBND
NOHIST = 0
DO 110 J = 1,NODATA
DO J = 1,NODATA
IF ( HISTO_DATA(J) .LE. BOUND(I) ) THEN
NOHIST = NOHIST + 1
ENDIF
110 CONTINUE
END DO
WRITE( 20, '(F10.2,I10)' ) BOUND(I), NOHIST
120 CONTINUE
END DO
END
......@@ -15,7 +15,7 @@ program hist
open( 10, file = '03_histogram.data', status = 'old', iostat = ierr )
if ( ierr /= 0 ) then
write( *, * ) 'file histogram.data could not be opened'
write( *, * ) 'file 03_histogram.data could not be opened'
stop
endif
......
0% Chargement en cours ou .
You are about to add 0 people to the discussion. Proceed with caution.
Terminez d'abord l'édition de ce message.
Veuillez vous inscrire ou vous pour commenter