Computer Programming involves instructing computer to perform tasks, using a instruction code called as Programming Language.
Programming Languages are classified as
Low Level Programming Language
High Level Programming Language
Low Level Programming languages are Computer Oriented, whereas, High Level Programming Languages are Human Oriented. We find it easier to program a computer using High Level Programming Language. FORTRAN is a High Level Programming Language. This language is suitable for Scientific/ Engineering applications.
The FORTRAN character set consists of letters, digits, and special characters.
A name must start with a letter and consists thereafter of any combination of letters, if required. Max six characters are allowed. FORTRAN reserved words are not allowed as Identifiers.
A complete executable program contains one main program unit and zero or more other program units, where each of these can be compiled separately. A program unit is one of the following:
• Main program unit
• External FUNCTION subprogram unit
• External SUBROUTINE subprogram unit
Execution of the program starts in the main program and then control can be passed between the main program and the other program units.
A FORTRAN statement can have a preceding label (number), composed of one to five digits. All statement labels in the same scoping unit must be unique. A statement number must appear within columns 1 to 5.
Comment lines may be included in a program. Such lines do not affect the program in any way but can be used by the programmer to include explanatory notes. If letter C, or c appears in column 1 of a line, that line is treated as a Comment and is ignored by the compiler.
• Column 1 to 5 are used for statement numbers.
• Column 6 is used for continuation. To treat a line as part of previous line type a digit in column 6.
• Columns 7 to 72 are used for writing FORTRAN statements.
• Columns 73 to 80 are used for writing short comments
The above rules are not applicable for a Comment.
The numeric types supported by FORTRAN are INTEGER, REAL, DOUBLE PRECISION and COMPLEX. The nonnumeric types are CHARACTER and LOGICAL.
The general form of a type declaration statement is:
data_type var1, var2,var3…
Examples of Type Declarations
REAL L, Z
DOUBLE PRECISION M, X, ROOT1
LOGICAL YESNO, PASS
INTEGER COUNT, MAXVAL
CHARACTER*20 NAME, ADDRESS, CITY
CHARACTER*15 STR1, STR2*55,STR3,STR4
Note: Here, NAME, SDDRESS, CITY are all treated as 20 character long strings of characters. STR1, STR3, STR4 are 15 character long strings, where as STR2 is a 55 character long string.
If an identifier is used without being explicitly declared, then the entity’s type will be determined from the first character of its name. This is known as implicit typing. The default implicit typing rules are as follows:
• Names with first character I to N are treated as INTEGER
• Names with first character other than I to N - i.e. A to H or O to Z - are treated as REAL
The IMPLICIT statement provides a means of changing or canceling the default implicit typing rules stated above.
Syntax
IMPLICIT type1(range1), type2(range2) …
IMPLICIT REAL(I-K)
Identifiers beginning with characters I, J and K will now be treated as REAL, if not explicitly declared otherwise.
Prevents Implicit Type Declaration. This is useful for debugging. When IMPLICIT NONE statement is used all the identifiers must be explicitly declared using Type Declaration statements.
Syntax
IMPLICIT NONE
An expression can consist of operands, operators, and parentheses. It defines a computation that upon evaluation yields a result.
The more general form of an expression is:
[operand1] operator operand2
If operand1 is present then the operator is binary (operates on two operands), otherwise it is a unary operator (operates on only one operand).
Intrinsic Operators
Category Operators Valid Operand Types
Arithmetic Operators: +, -, *, /, **
Relational Operators: .EQ. , .NE. , .LT., .LE. , .GT. , .GE.
Logical Operators: .NOT. , .AND. , .OR.
When an expression uses more than one operators, it is necessary to define the order in which the operators will operate. The operators in this case operate according to their precedence number. The precedence numbers of the operators are as follows…
Operator Precedence Operators
Highest
1 ()
2 **
3 *, /
4 +, -
5 .EQ. .NE. .LT. .LE. .GT. .GE.
6 .NOT.
7 .AND.
8 .OR.
Lowest
READ statement is used for accepting data from the user at the time of execution of the program. The syntax of READ statement is as follows…
READ(*,*) var1, var2, var3 …
Here, user will enter the values which will be assigned to the variables var1, var2, etc in the order in which the values are entered.
WRITE statement is used for displaying/ printing/ storing values of expressions listed. The syntax of WRITE statement is as follows…
WRITE(*,*) exp1, exp2, exp1 …
Here, the values will be displayed in the order in which the expressions are listed.
WRITE(*,*)’This is a text Output’
WRITE(*,*) A,B,M
WRITE(*,*)’Radius: ‘, R, ‘Area: ‘, A
READ(*,*)R
READ(*,*)X, Y, Z
Sample Program
PROGRAM DEMO
READ(*,*) B, H
A=0.5*B*H
WRITE(*,*)’Base Width: ‘, B, ‘ cm’
WRITE(*,*)’Height: ‘, H, ‘ cm’
WRITE(*,*)’Area: ‘, A, ‘ sqcm’
STOP
END
The normal flow of execution in a FORTRAN program is sequential. The statements execute in the order of their appearance in the program. However, you can alter this flow, using FORTRAN control structures and flow control statements.
Flow Control Statements
These statements are used for transferring control . These statements are of two types
Unconditional Flow Control Statements
Unconditional GOTO , Assigned GOTO, STOP
Conditional Flow Control Statement
Computed GOTO, Arithmatic IF, Logical IF
Unconditional GOTO Statement
The unconditional GOTO statement transfers control to the statement with the specified statement number. The statement with the specified statement number may appear before or after the GOTO statement, but it must be within the same program module scope.
Syntax
GOTO statement-number
Assigned GO TO Statement
The assigned GO TO statement transfers control to the statement whose statement label was assigned to an integer variable by an ASSIGN statement.
Syntax
GOTO integer-variable
ASSIGN Statement
Used for assigning a statement number to an integer variable. This must execute before executing GOTO statement.
Syntax
ASSIGN statement-number TO integer-variable
INTEGER int_label
...
ASSIGN 20 TO int_label
...
GOTO int_label
...
20 ...
The STOP statement terminates program execution. A program module can have as many STOP statements as required. The STOP statement is unlike END statement, which is a non executable statement used for indicating (physical) end (last line) of a program module. Each program module has one END statement but can not have more than one END statements.
Syntax
STOP
The computed GOTO statement transfers control to one of several labeled statements, depending on the value of an arithmetic expression.
Syntax
GOTO ( label-list ) , integer-expression
Execution Logic
1. integer-expression is evaluated.
2. The resulting integer value (the index) specifies the ordinal position of the label that is selected from label-list.
3. Control transfers to the executable statement with the selected label. If the value of the index is less than 1 or greater than the number of labels in label-list, the computed GOTO statement has no effect, and control passes to the next executable statement in the program.
The arithmetic IF transfers control to one of three labeled statements, as determined by the value of an arithmetic expression.
Syntax
IF ( arithmetic-expression ) label1, label2, label3
Execution Logic
1. arithmetic-expression is evaluated.
2. If the resulting value is negative, control transfers to the statement at
label1.
3. If the resulting value is 0, control transfers to the statement at label2.
4. If the resulting value is positive, control transfers to the statement at
label3.
Note that, two or more labels in the label list can be the same.
Example
IF ( i ) 10, 20, 10
The logical IF statement executes a single statement, based on the value of a logical expression. The statement it executes must be a unconditional executable statement.
Syntax
IF ( logical-expression ) executable-statement
Execution logic
1. logical-expression is evaluated.
2. If it evaluates to true, executable-statement executes.
3. The normal flow of execution resumes with the first executable statement following the IF statement. (If executable-statement is an unconditional GO TO statement, control resumes with the statement specified by the GO TO statement.)
Examples of Logical IF
IF(X .LT. Y) STOP
IF(I .GT. N) GOTO 100
IF(X .LE. 100)X=X+1
FORTRAN Control Structures
FORTRAN control structures are of two types
Control Structures for Selective Execution ( Block IF)
Control Structures for Repetitive/ Iterative Execution (DO Statements)
DO Statement/ Counter-controlled DO Statement
A counter-controlled DO loop uses an index variable to determine the number of times the loop executes.
Syntax
DO label index = inval, lastval [ , incr ]
statement-block
label terminal-statement
Here, index is a variable used for controlling the loop.
inval, lastval, incr are expressions.
incr is optional. If not specified, incr is treated as 1.
Execution logic
For +ve incr
1 index is assigned inval
2 The body of DO ( statement-block and terminal-statement) is executed if index <= lastval, otherwise control is transferred to the next statement outside the DO statement.
3 index is incremented by incr (index = index + incr), Step 2 is repeated again.
For -ve incr
1 index is assigned inval
2 The body of DO ( statement-block and terminal-statement) is executed if index >= lastval, otherwise control is transferred to the next statement outside the DO statement.
3 index is decremented by incr (index = index - incr), Step 2 is repeated again.
program demo
do 100 x=0.1, 2.3, 0.1
write(*,*) x
100 continue
stop
end
CONTINUE Statement
This is a dummy executable statement. The CONTINUE statement has no effect on program execution. It is generally used to mark a place for a statement label, especially when it occurs as the terminal statement of DO loop.
Syntax
CONTINUE
DO-WHILE Statement/ Conditional DO Loop
A conditional DO loop tests a logical expression as a condition for executing the next iteration.
Syntax
DO WHILE ( logical-expression )
statement-block
END DO
Execution Logic
1. The loop becomes active.
2. The logical-expression is evaluated. If the result of the evaluation is false, the loop becomes inactive, and the normal flow of execution resumes with the first executable statement following the END DO statement.
3. The statement-block executes.
4. Go to Step 2
Subscripted variables are variables with subscript. The subscript allows us to store more than one values under the same variable name. The values are accessed using the subscript. The subscript must be a non zero unsigned integer expression.
The subscripted variables (arrays) are declared using DIMENSION statement, which specifies the size of the array. The size of the array decides the maximum permissible value of the subscript.
Syntax
DIMENSION var1(size1), var2(size2) …
Size of the subscripted variables is specified as follows
Single Dimensional Array – n
Two Dimensional Array - m,n
Three Dimensional Array – m,n,l
Here, m,n,l are non zero unsigned integer numbers.
It is also possible to combine type declaration and array declaration using type declaration statement.
Examples of DIMENSION Statements
DIMENSION A(100), B(5,10)
INTEGER X(10)
Here, A has been declared as a 100 element single dimensional array (A(1) to A(100)). B is a two dimensional array(B(1,1) to B(5,10)). X is declared as a 10 element integer array.
This is a form of READ/ WRITE statement used for Input/ Output of arrays. This works like a combination of DO and READ/ WRITE statement.
Syntax
For reading a single dimensional matrix
READ(*,*)(var(index),index=inval,finval,incr)
For reading a two dimensional matrix row wise
READ(*,*)((var(indexI, indexJ),indexJ=invalJ,finvalJ,incrJ), indexI=invalI,finvalI,incrI)
For displaying a single dimensional matrix
WRITE(*,*)(exp(index),index=inval,finval,incr)
For displaying a two dimensional matrix row wise in a single row
WRITE(*,*)((exp(indexI, indexJ),indexJ=invalJ,finvalJ,incrJ), indexI=invalI,finvalI,incrI)
For displaying a two dimensional matrix row wise in matrix form – Combination of DO and Implied DO
DO label indexI=invalI,finvalI,incrI
WRITE(*,*)(exp(indexI, indexJ),indexJ=invalJ,finvalJ,incrJ)
Label CONTINUE
Examples of DIMENSION Statements
READ(*,*)(X(I),I=1,N)
READ(*,*)(X(I,J), J=1,N),I=1,M)
A FORTRAN program consists of one main program and zero or more subprograms. The program execution always begins with the main program. The main program may call a subprogram if required. The subprogram in turn may call another subprogram(s), if required. At the end of execution of the subprogram the control is returned back to the calling program.
Values are passed to the called subprogram through the argument list. Arguments in the calling program module are called as actual arguments, whereas the arguments in the called subprogram are called as dummy arguments. The values are always passed sequentially, i.e. the first dummy argument gets value of first actual argument irrespective of their names. Names of dummy arguments and actual arguments need not be same or similar.
Subprograms are of two types
Statement Function
Function Subprograms
Subroutine Subprogram
A statement function is used for executing a single expression. A Statement Function must appear in the scope in which it is used.
Syntax
function-name(arg-list)=expression
Example Program
PROGRAM DEMO
AREATR(BASE,HEIGHT)=0.5*BASE*HEIGHT
READ(*,*)B,H
A=AREATR(B,H)
WRITE(*,*)'Base Width: ', B, ' cm'
WRITE(*,*)'Height: ', H, ' cm'
WRITE(*,*)'Area: ', A, ' sqcm'
STOP
END
A Function subprogram is executed when called by main program or by a subprogram. The Function subprogram is used for returning a value. The value is returned to the calling program module through the function name. The value to be returned is assigned to the function name before returning control to the calling program. The control is returned to the calling program through the RETURN statement. The RETURN statement need not be last statement. It appears at the location where control is required to be transferred to the calling program module.
Syntax
FUNCTION function-name(arg-list)
[statements]
function-name=expression
[statements]
RETURN
END
Example Program
PROGRAM DEMO
READ(*,*)B,H
A=AREATR(B,H)
WRITE(*,*)'Base Width: ', B, ' cm'
WRITE(*,*)'Height: ', H, ' cm'
WRITE(*,*)'Area: ', A, ' sqcm'
STOP
END
FUNCTION AREATR(BASE,HEIGHT)
AREATR=0.5*BASE*HEIGHT
RETURN
END
A Subroutine subprogram is executed when called by main program or by a subprogram. A Subroutine is called using CALL Statement. Data is passed to the Subroutine through the argument list. The values are also returned through the argument list. The subroutine can therefore return more than one values to the calling program. This is unlike Function which can return only one value through the Function name. The control is returned to the calling program through the RETURN statement. The RETURN statement need not be the last statement. It appears at the location where control is required to be transferred to the calling program module.
Syntax
SUBROUTINE subroutine-name(arg-list)
[statements]
RETURN
END
Example Program
PROGRAM DEMO
READ(*,*)B,H
CALL AREATR(B,H,A)
WRITE(*,*)'Base Width: ', B, ' cm'
WRITE(*,*)'Height: ', H, ' cm'
WRITE(*,*)'Area: ', A, ' sqcm'
STOP
END
SUBROUTINE AREATR(BASE,HEIGHT,AREA)
AREA=0.5*BASE*HEIGHT
RETURN
END
The COMMON statement defines one or more named or unnamed storage areas to be shared by different program units. This creates global data.
COMMON Statements are of two types.
Blank COMMON
Named COMMON
Syntax
COMMON var1, var2, var3…
The COMMON statement contains a list of variables to be stored in common memory. Each module which need access to this common area must include the COMMON statement.
Example Program
PROGRAM DEMO
COMMON A,B,C
…
STOP
END
SUBROUTINE SUB1
COMMON B1,B2,B3
…
RETURN
END
FUNCTION FUN1
COMMON X,Y,Z
…
RETURN
END
Here, A, B1, and X will share same memory location. Similarly B, B1, Y, and also C, B3, Z will share same memory location. This also means change in value of one of the variables sharing the same memory location affects values of other variables. For example change in value of B2 changes value of B and Y.
Syntax
COMMON /name/ var1, var2, var3…
Here we can create more than one common areas by naming them.
PROGRAM DEMO
COMMON /AREA1/A,B,C
COMMON /AREA2/ X,Y
…
STOP
END
SUBROUTINE SUB1
COMMON /AREA1/B1,B2,B3
…
RETURN
END
FUNCTION FUN1
COMMON /AREA1/X,Y,Z
COMMON /AREA2/P,Q
…
RETURN
END
This statement lets variables from same module share memory location.
Syntax
EQUIVALENCE (list1),(list2)…
Here, list1 is a list of variables which share same memory location. Similarly all the variables in list2 share memory location. This creates equivalent variables. For example if we wish to state that variables R and RADIUS are essentially same then we can write EQUIVALENCE statement as
EQUIVALENCE (R, RADIUS)
This statement is used for initializing variables
Syntax
DATA var1, var2, var3 … / n*val1, m*val2 …/
Here, n, m etc are the –optional – multipliers. The number of variables and the number of values must be the same.
DATA A, B, C/2, 2, 2/ is same as DATA A, B, C/ 3*2 /
We can also initialize arrays using DATA as follows
REAL B(100)
DATA B/50*5, 50*2.5/
To partially initialize an array we can use following form
REAL B(100)
DATA (B(I),I=1,70)/70*2.221/
Matrix Addition Program
program matadd
dimension a(10,10),b(10,10),c(10,10)
write(*,*)'Program to perform Matrix Addition...'
write(*,*)'Number of rows '
read(*,*)m
write(*,*)'Number of columns '
read(*,*)n
write(*,*)'Enter elements of first matrix row wise...'
read(*,*)((a(i,j),j=1,n),i=1,m)
write(*,*)'Enter elements of second matrix row wise...'
read(*,*)((b(i,j),j=1,n),i=1,m)
do 100 i=1,m
do 200 j=1, n
c(i,j)=a(i,j)+b(i,j)
200 continue
100 continue
write(*,*)'The Resultant Matrix is ...'
write(*,*)
do 300 i=1,m
write(*,*)(c(i,j),j=1,n)
300 continue
stop
end
PROGRAM TRANSP
DIMENSION A(10,10),AT(10,10)
WRITE(*,*)'Program to Generate Transpose of a Matrix'
WRITE(*,*)'NUMBER OF ROWS'
READ(*,*)M
WRITE(*,*)'NUMBER OF COLUMNS'
READ(*,*)N
WRITE(*,*)'ENTER ELEMENTS ROW WISE'
READ(*,*)((A(I,J),J=1,N),I=1,M)
DO 100 I=1,M
DO 100 J=1,N
100 AT(J,I)=A(I,J)
WRITE(*,*)'TRANSPOSE OF THE GIVEN MATRIX IS ...'
DO 200 I=1,N
WRITE(*,*)(AT(I,J),J=1,M)
200 CONTINUE
STOP
END
PROGRAM SYMCHK
DIMENSION A(10,10)
WRITE(*,*)'Program to Check Symmetry of a Matrix'
WRITE(*,*)'NUMBER OF ROWS'
READ(*,*)M
WRITE(*,*)'ENTER ELEMENTS ROW WISE'
READ(*,*)((A(I,J),J=1,M),I=1,M)
DO 100 I=1,M
DO 100 J=I+1,M
IF(A(I,J) .NE. A(I,J)) THEN
WRITE(*,*)'MATRIX UNSYMMETRIC'
STOP
ENDIF
100 CONTINUE
WRITE(*,*)'MATRIX SYMMETRIC'
STOP
END
program matmul
dimension a(10,10),b(10,10),c(10,10)
write(*,*)'Program to perform Matrix Multiplication...'
write(*,*)'Number of rows of First Matrix'
read(*,*)m
write(*,*)'Number of columns of First Matrix'
read(*,*)n
write(*,*)'Number of columns of Second Matrix'
read(*,*)l
write(*,*)'Enter elements of first matrix row wise...'
read(*,*)((a(i,j),j=1,n),i=1,m)
write(*,*)'Enter elements of second matrix row wise...'
read(*,*)((b(i,j),j=1,l),i=1,n)
do 100 i=1,m
do 200 j=1, n
c(i,j)=0.0
do 300 k=1,l
c(i,j)=c(i,j)+a(i,k)*b(k,j)
300 continue
200 continue
100 continue
write(*,*)'The Resultant Matrix is ...'
write(*,*)
do 400 i=1,m
write(*,*)(c(i,j),j=1,l)
400 continue
stop
end
Created For Department of Civil Engineering, Prof
Ram Meghe Institute of Technology & Research,
Badnera.
Course Notes Covering Syllabus for 6SC1 – Numerical Methods and Computer Programming (Units 1,2 & 3 only).