Chapter 5 Controlling the flow of your program

1
Chapter 5 Controlling the flow of your program
5.1 Choice and decision-making 5.2 Logical
expressions and LOGICAL variables 5.3 The block
IF construct 5.4 The logical IF
statement 5.5 Comparing character strings 5.6
The CASE construct 5.7 Obsolete forms of control
statements
2
5.1

• Program executes alternative instructions
  depending on conditions
• Block IF construct
• E.g. For x gt 0
• IF(ABS(x) lt 1.E-20) THEN
• cube_root 0.0
• ELSE
• cube_root EXP(LOG(x)/3.0 )
• ENDIF
• Note X in F90 is ABS(X)
• X 1/3 elog(x)/3

3
5.1
Fortran 90 alternatives IF (criterion_1)
THEN action_1 ELSE IF (criterion_2)
THEN action_2 ELSE IF (criterion_3)
THEN action_3 ELSE action_4 END IF A
minimal block IF IF (criterion)
THEN action END IF
4
5.2 Logical expressions and LOGICAL variables
-Logical values are true or false In FORTRAN
90 .TRUE.
.FALSE. are the constants for true or
false. -Logical expressions e.g.
L a gt b !e.g. true for a3, b1
x y ! e.g false for x 3, y 1
Also, are called relational expressions and
gt , are relational operators.
5
5.2 (2)
Relational operators and expressions a lt
b and a .LT. b are true if a is less than b a lt
b and a .LE. b are true if a is less than or
equal to b a gt b and a .GT. b are true if a is
greater than b agtb and a .GE. B are true
if a is greater than or equal to b a b and a
.EQ. b are true if a is equal to b a / b and a
.NE. b are true if a is not equal to
b Redundancy in using operators for log.
Expression of the same condition e.g
b2 gt 4ac b2-4ac gt 0
!e.g. TRUE for b 5, a 2, c 3
4ac lt b2 4ac-b2 lt 0
6
5.2 (3)
-Also rel. operators can express relation
between char. expressions e.g string_1
lt string_2 Adam lt Eve !
True LOGICAL vars
LOGICAL var_1, var_2, var_3 e.g var_1 (a
gt b) consts .TRUE. , .FALSE. Write
functions which deliver a logical value
LOGICAL FUNCTION logical_fun (arg1,
...) . . or FUNCTION logical_fun
(arg1, ...) LOGICAL logical_fun .
7
5.2 (5)
Form composite logical expressions using .OR. ,
.AND. logical operators e.g (altb) .OR. (cltd)
or (xlty) .AND. (yltz) ( , ) can be
omitted e.g altb .OR. cltd ! But may confuse us
so use ( , ) (altb) .OR. (cltd) e.g. a 2 ,
b 3 , c 5 , d 3 gt value of log.expr.
.TRUE.
8
5.2 (6)
The logical operators .OR. and .AND.
L1 L2 L1.OR.L2 L1.AND.L2 true true true
true true false true false false true true fa
lse false false false false e.g. L1 (a lt b)
!as above L2 (c lt d) !as above L1. OR
.L2 .TRUE. L1. AND .L2 .FALSE The logical
operators .EQV. and .NEQV.. L1 L2
L1.EQV.L2 L1.NEQV.L2 true true true false
true false false true false true false true fa
lse false true false
9
5.2 (7)
.EQV. If both expressions have the same value,
else .NEQV. .gt useful to simplify structure of
the expressions The following two expressions
are identical in their effect
L1 L2 L3
L4 e.g. (I) (altb .AND. xlty) .OR. (agtb
.AND. xgty) (II) altb
.EQV. xlty L1
L2 The explanation for this follows by writing
the truth Table for each (I) and (II) and
checking that the same T , F occur in all
cases (e.g. a2, b3, x5, y8 )
10
5.2 (7)

11
5.2 (8)
. NOT. is a unary operator gives .TRUE. for value
.FALSE. and vice-versa e.g. The following
expressions are equivalent in their effect
(I) .NOT. (altb .AND. bltc) !e.g. a 2 , b
3 (II) agtb .OR. bgtc !
c 5 And, of course (I) .NOT. (altb
.EQV. xlty) (II) altb .NEQV. xlty .NOT. Helps
clarify expressions . (ab) lt (cd)
.Order 1st arithmetic operators (e.g. , ,
etc) 2nd relational operators
(e.g. lt , etc) 3rd logical
operators
12
5.2 (9)
Logical operator priorities Operator Priorit
y   . NOT. highest .AND. .OR. .EQV. and
.NEQV. lowest
13
5.3 The block IF construct
The block IF construct is IF
(logical_expression) THEN ELSE IF
(logical_expression) THEN e.g. IF(.NOT. (a lt b.
AND. b lt c)) X a b
ELSE IF (a lt b. AND. b lt c) X
c b ENDIF
14
5.3 (3)
The block IF structure IF (logical expression)
THEN block of Fortran statements ELSE IF
(logical expression) THEN block of Fortran
statements ELSE IF (logical expression)
THEN . . . ELSE block of Fortran
statements END IF
15
5.3 (4)
EXAMPLE 5.1 (1) Problem Example 4.1 calculated
the number of bags of wheat that were required
to sow a triangular field. 2s a b
c gt area (s(s-a)(s-b)(s-c))1/2 Use IF
statement for no. of full bags needed to sow the
field. Analysis quantity(of wheat) area
density gt no. of bags quantity
/ 10,000 0.9 (to allow for
partly used bag). Better way use IF
16
5.3 (5)
(2) Structure Plan 1 Read lengths of sides of
field (a, b and c) 2 Calculate the area of the
field 3 Read the sowing density 4 Calculate
the quantity of seed required 5 Calculate number
of full bags needed 6 If any more seed is needed
then 6.1 Add one to number of bags 7 Print
size of field and number of bags
17
5.3 (6)
(3) Solution (p139.f) PROGRAM wheat_sowing IMPLIC
IT NONE   ! A program to calculate the quantity
of wheat required to     ! sow a triangular field
     ! Variable declarations   REAL a, b, c,
s, area, density, quantity   INTEGER
num_bags   ! Read the lengths of the sides of
the field   PRINT , "Type the lengths of the
three sides of the field   in meters "  
READ , a, b, c  
18
5.3 (7)
! Calculate the area of the field   s
0.5(abc)   area SQRT(s(s-a)(s-b)(s-c))
    ! Read sowing density   PRINT ,
"What is the sowing density (gm/sq.m.)? "  
READ , density     ! Calculate quantity of
wheat in grams and the number of   ! full 10
kg bags   quantity densityarea  
num_bags 0.0001quantity !partly-full bag is
excluded (i) ! In section 4.1
num_bags 0.0001quantity0.9! To round up
19
5.3 (8)
! Check to see if another bag is required  
IF (quantity gt 10000num_bags) THEN  ! (ii)
num_bags num_bags1   END IF   !
Print results   PRINT , "The area of the
field is ", area, " sq. meters"   PRINT ,
"and ", num_bags, " 10 kilo bags will be
required"     END PROGRAM wheat_sowing  
20
5.3 (9)
NOTE 1. In (i), num_bags is INTEGER and
quantity is REAL 2. In (ii), quantity gt
10000 num_bags is converted to
REAL
(quantity - 10000
num_bags ) gt 0.0
3. Accuracy of real arithmetic
recall REAL nos are stored as
approximations in the computer e.g. with 6
significant figures 25.39004 is stored as
25.3900 OR 25.39. Also in operations e.g
Rounding in hand calculation 25.39
17.25 437.9775 437.978 If 7-th digit
0,..,4 truncate from 7-th digit on. If
7-th digit 5,..,9 add 1 to 6-th digit
truncate from 7-th digit on 4. Computer
rounding is similar. Recall e.g. Fig.3.3 Mantissa
or fraction exponent form 0 3 4 1 3
7 0 2 .413702103 413.702 exp
fraction
21
5.3 (10)
For nos in Fig.5.10 25.39 .253900
102, 17.25 .172500 102 and 25.3917.25
.4379775 103 .437978 103 5.The no. of
digits in the fractions allowed(e.g in the
example is 6) is called precision. Real
type has 24 bits 7 or 8 decimal digits.
DOUBLE PRECISION type (in chapter 10) allows 14
or 15 decimal digits. 6. In REAL INTEGER
expressions INTEGER are converted to
REAL e.g. (Chapter 3) a bc/d (b 100.0, c 9,
d 10) gt bc 900.0 gt 90.0 BUT a c/db
gt (c/d 0, INTEGER division) gt a
0.0 7. (a) For (i) Convert REAL to INTEGER
before storing result. (b) For (ii)
compare or subtract 2 real nos which are almost
equal e.g. Farm field sides a130m c,
b100m, density 25g/m2 gtarea
6000m2 gt 150kg seed gt num_bags 15
22

• In computer possibly area 5 999.999 999 or
  6000.000 001
• gtnum_bags.0001quantity14.999 999 99OR 15.000
  000 01
• which are approx 15
• BUT if we simply truncate to get INTEGER we get
  14 or 15 if
• We compute 10000num_bags and e.g. quantity
  150000.0001
• then (quantity-10000num_bags)gt0.0 is .TRUE. gt
  16 bags.
• To allow for (round) errors less than 10 write
  prog
• REAL Mixed
  (INTEGER,REAL)
• IF (quantity gt
  10000num_bags1000) THEN
• num_bags num_bags 1
• END IF

23
5.3 (11)
OR BETTER avoid num_bags REAL
REAL
REAL IF (0.0001quantity -
INT(0.0001quantity) gt 0.1) THEN num_bags
num_bags 1 END IF e.g. INT(150,000.0001)
150,000
24
5.3 (12)
EXAMPLE 5.2 (1) Problem Write an external
function for X1/3 (2) Analysis We
have done X1/3 cube root EXP(LOG(X))/3.0) for
X gt 0 Need (-X)1/3 -(X)1/3 for
X gt0 and (0)1/3 0 special case because
Log(X) undefined for X 0
25

• Data design
•  
• Purpose Type Name
• A Dummy argument
• Value whose cube REAL x
• root is required
• B Result variable
• Cube root of x REAL cube_root
• C Local constant
• A very small number REAL epsilon
• 
  e.g. 1E-20

26
5.3 (13)
Structure plan  Real function cube_root(x)   1 If
1.1 Return zero else if xlt0 1.2 Return
exp(log(-x)/3) else 1.3 Return exp(log(x)/3)
27
5.3 (14)
(3) Solution (p143.f) REAL FUNCTION
cube_root(x) IMPLICIT NONE   ! Function to
calculate the cube root of a   ! real number
  ! Dummy argument declaration   REAL,
INTENT(IN) x     ! Local constant   REAL,
PARAMETER epsilon1.E-20
28
5.3 (15)
! Eliminate (nearly) zero case IF
(ABS(x)ltepsilon) THEN cube_root 0.0 !
Calculate cube root by using logs ELSE IF (xlt0)
THEN ! First deal with negative
argument cube_root -EXP(LOG(-x)/3.0)
ELSE ! Positive argument cube_root
EXP(LOG(x)/3.0) END IF   END FUNCTION cube_root
29
5.3 (16)

• EXAMPLE 5.3
• Problem
• Modify the subroutine line_two_points, so that it
  returns
• an error flag to indicate that either
• (a) the two points were distinct, and the
  equation of
• the joining line was therefore calculated, or
• (b) it was not possible to calculate the line
  because
• the points were coincident.

30
5.3 (17)
(2) Analysis Need logical error flag for equal
points Return STATUS 0 for distinct pts and
STATUS -1 otherwise Structure plan Subroutine
line_two_points(line_1, point_1, point_2,
status) TYPE(line) line_1 TYPE(point)
point_1, point_2 INTEGER status 1 If point_1
and point_2 are coincident 1.1 Set status to
1 Else 1.2  Calculate coefficients of the
line joining the points 1.3  Set status to 0
31
5.3 (18)
(3) Solution (p144.f) MODULE geometric_procedures
USE geometric_data   IMPLICIT NONE CONTAINS  
SUBROUTINE line_two_points(line_1,point_1,point_
2,status) IMPLICIT NONE ! Dummy
arguments TYPE(Line), INTENT(OUT) line_1  
TYPE(Point), INTENT(IN) point_1,point_2 
INTEGER status
32
5.3 (19)
! Check to see whether points are coincident
. Need to use ! epsilon 1.E-20 and IF(
ABS( - ) lt epsilon .AND. .. ) IF
(point_1xpoint_2x .AND. point_1ypoint_2y)
THEN ! Points are coincident - return error
flag status -1 ELSE ! Points are
distinct, so calculate the coefficients 
! of the equation representing the line 
line_1a point_2y - point_1y 
line_1b point_1x - point_2x 
line_1c point_1ypoint_2x -
point_2ypoint_1x ! Set status to
indicate success  status 0  END
IF END SUBROUTINE line_two_points END MODULE
geometric_procedures  
33
5.4 The logical IF statement
The logical IF statement omits THEN IF
(logical expression) Fortran statement e.g.
IF(quantity gt 10000num_bags) num_bags
num_bags1 This is exactly equivalent to a block
IF with a block consisting of a single
statement IF (logical expression)
THEN Fortran statement END IF
34
5.5 Comparing character strings
The six relational operators could be used to
compare character expressions and
constants. e.g. Adam gt Eve ! ? True The
key is the collating sequence of letters, digits
and other characters. Six rules (1) The 26
upper case letters are collated in the following
order A B C D E F G H I J X L M N 0 P Q R S T U
V W X Y Z (2) The 26 lower case letters are
collated in the following order a b c d e f g h
i j k 1 m n o p q r s t u v w x y z (3) The 10
digits are collated in the following order 0 1
2 3 4 5 6 7 8 9
35
5.5 (2)
(4) Digits are either all collated before the
letter A, or all after the letter Z (5) Digits
are either all collated before the letter a, or
all after the letter z (6) A space (or blank) is
collated before both letters and digits The
other 22 characters in the Fortran character set
do not have any defined position in the
collating sequence.
36
5.5 (3)

• When two character operands are being compared
  there are
• three distinct stages in the process
• If the two operands are not the same length, the
  shorter one
• is treated as though it were extended on the
  right with blanks.
•  
• (2) The two operands are compared character by
  character,
• starting with the leftmost character.
• If a difference is found the character which
  comes earlier in
• the collating sequence being deemed to be the
  lesser of the two.
• If no difference is found, then the strings are
  considered to be equal.

37
5.5 (4)
e.g. Adam gt Eve
!False Adam lt Eve
!True Adam lt
Adamant !True lt a
120 lt 1201 !True
lt 1 ADAM lt Adam
!Not defined D d XA
lt X4 !Not defined A
4 var_1 lt var-1
!Not defined _ - NOT a problem,
because strings are compared usually (?) if they
are equal e.g. XA X4 !False
38
5.5 (5)
Standard does not define whether upper case
letters come before or after lower case
letters. The value of s1"ADAM" lt s2"Adam"
will depend upon the particular computer system
being used. There are intrinsic functions which
use the ASCII chars order to decide the
order of strings Intrinsic functions for lexical
comparison LGT(sl, s2) is the same as sl gt s2
using ASCII character ordering. LGE(sl, s2)
is the same as sl gt s2 using ASCII character
ordering. LLE(sl, s2) is the same as sl lt s2
using ASCII character ordering. LLT(sl, s2)
is the same as sl lt s2 using ASCII character
ordering.
39
5.5 (6)
If it is required to define the ordering of all
characters, another way of comparing uses the
ordering of characters defined in the American
National Standard Code for Information
Interchange referred to as ASCII.(Appendix
D) e.g. in Fortran Miles gt miles is
undefined. But LGT (Miles,miles) .FALSE.
(because M before m in ASCII)
40
5.5 (7)

• EXAMPLE 5.4
• (1) Problem
• Write a function which takes a single character
  as its argument
• and returns a single character according to the
  following rules
• If the input character is a lower case
  letter then
• return its upper case equivalent.
• If the input character is an upper case
  letter then
• return its lower case equivalent.
• If the input character is not a letter then
  return it unchanged.

41
5.5 (8)
(2) Analysis IACHAR provides the position of its
character argument in the ASCII
collating sequence ACHAR returns the character at
a specified position in that
sequence.   Every lower case character is exactly
32 positions after its upper case
equivalent. Use intrinsic functions
IACHAR(A) 65 (position in ASCII) ACHAR(97)
a. Note position (in ASCII) of lower case
letter position (in ASCII) of upper
case letter 32 e.g. IACHAR(a)
IACHAR(A) 97-65 32
42
5.5 (9)
e.g. A gt a, change_case ACHAR(IACHAR(A)32)

ACHAR(6532) ACHAR(97) a a gt A,
change_case ACHAR(IACHAR(a)-32)
ACHAR(97-32)
ACHAR(65) A Data design
Purpose Type Name A Dummy
argument Character to be CHARACTER1 char con
verted  B Result variable Converted
character CHARACTER1 change_case  C Local
constant Offset between upper
INTEGER upper_to_lower and lower case in
the ASCII character set
43
5.5 (10)
44
5.5 (11)
(3) Solution (p150.f) CHARACTER FUNCTION
change_case(char) IMPLICIT NONE   ! This
function changes the case of its argument (if it
! is alphabetic)   ! Dummy argument
CHARACTER, INTENT(IN) char ! Local
constant INTEGER, PARAMETER upper_to_lower
IACHAR("a")-IACHAR("A") ! Check if
argument is lower case alphabetic, upper case
! alphabetic, or non-alphabetic
45
5.5 (12)
IF ("A"ltchar .AND. charlt"Z") THEN !
Upper case - convert to lower case
change_case ACHAR(IACHAR(char)upper_to_lower)
ELSE IF ("a"ltchar .AND. charlt"z") THEN
! Lower case - convert to upper case
change_case ACHAR(IACHAR(char)-upper_to_low
er)   ELSE ! Not alphabetic
change_case char END IF   END
FUNCTION change_case
46
5.6 The CASE construct
The CASE construct deal with many alternatives
are mutually exclusive. The CASE
structure SELECT CASE (case expression) CASE
(case selector) !mutually exclusive case block
of Fortran statements CASE (case selector)
!mutually exclusive case block of Fortran
statements   . . END SELECT Note expression
is integer, char, logical. But real expressions
are not allowed.
47
5.6 (2)
e.g. CHARACTER(LEN2) month and assume we want
to consider the first 6 nos and the last 6
nos SELECT CASE(month)
CASE(01, 02, 03,
04, 05, 06)
-statement CASE(07,
08, 09, 10, 11, 12)
-statement END
SELECT
48
5.6 (5)
EXAMPLE 5.5 (1)  Problem Date yyyy
mm dd Prog. input date
Output what season it is in Australia
(2) Analysis Data design  Purpose Type Name Da
te (yyyy-mm-dd) CHARACTER10 date Month (for
CASE) CHARACTER2 month
49
5.6 (7)
Structure plan 1 Read date 2 Extract month from
date 3 Select case on month 3.1 month is 8, 9 or
10 Print spring 3.2 month is 11, 12, 1,
2 or 3 Print summer 3.3 month is 4 or
5 Print autumn 3.4 month is 6 or 7
Print winter 3.5 month is anything else
Print an error message
50
5.6 (8)
(3) Solution (p155.f) PROGRAM seasons IMPLICIT
NONE   ! A program to calculate in which
season a specified date lies   ! Variable
declarations CHARACTER(LEN10) date
CHARACTER(LEN2) month ! Read date PRINT
, "Please type a date in the form yyyy-mm-dd"
READ , date   ! Extract month number
month date(67)
!2006-09-21
51
5.6 (9)
! Print season SELECT CASE (month) CASE
("08""10") PRINT , date, " is in the
spring" CASE ("11", "12", "01""03")
PRINT , date, " is in the summer" CASE
("04", "05") PRINT , date, " is in the
autumn" CASE ("06", "07") PRINT ,
date, " is in the winter" CASE DEFAULT
PRINT , date, " is not a valid date" END
SELECT   END PROGRAM seasons
52
5.6 (10)
53
5.6 (11)
Three possible cases (1)      b2 gt 4ac (2)     
b2 4ac (3)      b2 lt 4ac Real arithmetic is
only an approximation. We should never compare
two real numbers for equality. Thus we could
rewrite the second case as (2) Epsilon is a
very small number. e.g. 1E - 20
54
5.6 (12)
If we wish to use a CASE statement, we could
dividing the value of b2 - 4ac by epsilon and
then assigning the result to an integer for use
in the CASE statement. The approach that we have
chosen should not be used in a real programming
situation. Data design
CASE
IF Purpose Type Name 
A Local constant A small
value REAL epsilon B Local variables

same Coefficients REAL a, b, c
Intermediate value REAL d CASE selection
value INTEGER selector
55
5.6 (13)
Structure plan 1 Read the three coefficients a,
b and c 2 Calculate d b2-4ac 3 Calculate
selector (int(d/epsilon)) 4 Select case on
selector 4.1 selectorgt0 (i.e gt 1)
Calculate and print two roots 4.2 selector0
Calculate and print a single
root 4.3 selectorlt0 (i.e lt -1)
Print a message to the effect that that there are
no real roots
56

• Case d 0
• d b2 - 4ac
• d/epsilon lt 1 means d 0
• int(d/epsilon) 0
• Case d gt 0
• int(d/epsilon) gt 1
• Case d lt0
• int(d/epsilon) lt -1

57
5.6 (16)
(3) Solution (a)   Using a CASE construct
(p159.f) PROGRAM quadratic_by_CASE IMPLICIT
NONE   ! A program to solve a quadratic
equation using a CASE ! statement to
distinguish between the three cases   !
Constant declaration REAL, PARAMETER
epsilon1E-20 ! Variable declarations REAL
a, b, c, d, sqrt_d, x1, x2 INTEGER
selector
58
5.6 (17)
! Read coefficients PRINT , "Please type the
three coefficients a, b and c" READ , a, b,
c   ! Calculate b2-4ac and resulting case
selector d b2 - 4.0ac selector
int(d/epsilon) ! Calculate and print roots, if
any SELECT CASE (selector) CASE (1) ! Two
roots sqrt_d SQRT(d) x1 (-bsqrt_d)/(aa) x
2 (-b-sqrt_d)/(aa) PRINT , "The equation has
two roots ", x1, " and ", x2
59
5.6 (18)
CASE (0) ! One root x1
-b/(aa) PRINT , "The equation has one
root ", x1   CASE (-1) ! No roots
PRINT , "The equation has no real
roots"   END SELECT   END PROGRAM
quadratic_by_CASE
60
5.6 (19)

• IF solution program
• Structure plan
• Read coefficients ! -epsilon lt d lt
  epsilon
• 2 Calculate b2-4ac, and store it in d
  ! means d lt epsilon
• 3 If d gt epsilon then
  ! i.e. d 0
• 3.1 calculate and print two roots
• else if dgt-epsilon then !
  epsilon gt dgt -epsilon
• 3.2 Calculate and print a single root
• otherwise !
  d lt -epsilon
• 3.3 Print a message to the effect that there
  are no real roots

61
5.6 (20)
(b) Using an IF construct (p160.f)   PROGRAM
quadratic_by_block_IF IMPLICIT NONE   ! A
program to solve a quadratic equation using a
block IF ! statement to distinguish between
the three cases   ! Constant declarations
REAL, PARAMETER epsilon1E-20   !
Variable declarations REAL a, b, c, d,
sqrt_d, x1, x2
62
5.6 (21)
! Read coefficients PRINT , "Please type the
three coefficients a, b and c" READ , a, b,
c   ! Calculate b2-4ac d b2 -
4.0ac   ! Calculate and print roots, if any
IF (dgtepsilon) THEN ! Two roots
sqrt_d SQRT(d) x1 (-bsqrt_d)/(aa)
x2 (-b-sqrt_d)/(aa) PRINT , "The
equation has two roots ", x1, " and ", x2
63
5.6 (22)
ELSE IF (dltepsilon.AND.dgt-epsilon) THEN
! One root x1 -b/(aa) PRINT
, "The equation has one root ", x1   ELSE
IF(dlt-epsilon) ! No roots PRINT
, "The equation has no real roots"   END
IF   END PROGRAM quadratic_by_block_IF
64
5.6 (23)
Better d1 ABS(d) IF (d1 lt
epsilon)THEN !One root x1 -b / (a
a) ELSE IF (d lt -epsilon)THEN !No
roots ELSE !Two roots x1 x2
END IF