Exercise material ================= All the exercise material (including answers) is adapted from the Fortran 95 -course at CSC by Tommi Bergman, Jarmo Pirhonen and Sami Saarinen, 2010. http://www.csc.fi/english/csc/courses/archive/fortran2010 The exercises follow closely the CSC's guide Fortran 95/2003 (only in Finnish) by Juha Haataja, Jussi Rahola and Juha Ruokolainen, CSC - Tieteellinen laskenta Oy. The example answers will be available on-line when the course ends http://napsu.karmitsa.fi/courses/supercomputing/ Emacs editor and fortran modes ============================== o For editing Fortran program files you can use Emacs editor without (the option -nw) or with X-windows: emacs -nw filename.f90 or emacs filename.f95 o Emacs fortran mode: On some Linux workstations it may be necessary first load f90 lisp library: Esc X load- library and then f90. Indentation and highlighting works then by default. Fortran compiler ================ The GNU Compiler Collection (GCC) Fortran 95 compiler gfortran is used. It supports also FORTRAN 77 and Fortran 90. The newest versions implement also some or all Fortran 2003 and Fortran 2008 features. The GCC online documentation of the latest versions: http://gcc.gnu.org/onlinedocs/ On Linux workstations the command gfortran (version 4.8.2) can be used directly to launch the GCC Fortran compiler. Using the Gfortran compiler in Taito ==================================== First you need to swap the default Intel compiler to GNU compiler, give command: module swap intel gcc In order to compile the file mycode1.f95 (a source code file) gfortran -c mycode1.f95 The output file will be mycode1.o (a object code file). You can link your object files together to generate an executable gfortran -o ExecutableName mycode1.o mycode2.o mycode3.o Here the executable will be called ExecutableName and the object files were created as explained earlier. If the flag -o ExecutableName is omitted, then the executable will be named as a.out (on UNIX/Linux systems). You can skip the separate compilation step by entering gfortran -o ExecutableName mycode1.f95 mycode2.f95 mycode3.f95 ... This will compile the source files ( mycode1.f95 mycode2.f95 mycode3.f95 ...), link and generate an executable ExecutableName - all in one step. You could also add object file names to this command line and they would automatically be linked in during the link step. You can run the program by entering ./ExecutableName Source files whose names end with .f90 or .f95 are assumed to be free form -files. If file name ends with .f or .for then the files are assumed to be fixed form -files (the fixed form is an older Fortran source code style not recommended any more). Simple compilation - Example program test.f95: PROGRAM test IMPLICIT NONE INTEGER, PARAMETER :: result = 42 ! Simple output statement... PRINT *, 'Hello world!' PRINT *, 'The result is ', result END PROGRAM test Compilation and execution: % gfortran test.f95 -o test % ./test Hello world! The result is 42 Fortran Exercises and Answers: ============================== 1. What means the following (free format) code line: A = 0.0 ; B = 370 ! Initialization ; C = 17.0 ; D = 33.0 Answer: ------- All the text after the exclamation mark is interpreted as comment. Only A and B will get values. 2. Is the following syntactically correct Fortran 95 code? Y = SIN(MAX(X1,X2)) * EXP(-COS(X3)**I) - TAN(AT& & AN(X4)) Answer: ------- In this case the space character is not allowed after the continuation line mark on the second line, because with it ATAN(X4) is read as AT AN(X4). Therefore it is a syntax error. 3. Are the following Fortran statements written correctly? character_string = 'Awake in the morning, & asleep in the evening.' x = 0.4-6 answer = 'True & false' low-limit = 0.0005E10 y = E6 Answer: ------- - the continuation line mark & is missing from the end of the first line - the second statement is correct, the result is -5.6 - the third statement is correct, it declares a character string, not logical entities - the hyphen is not allowed in the names of the variables, should be low_limit or lowlimit - the mantissa of the exponent notation is missing from the last statement, should be, e.g., y = 1E6 4. Are the following declarations legal in Fortran: CHARACTER(LEN=*), PARAMETER :: "Name" REAL :: pi = 22/7 REAL :: x = 2., y = -3 REAL :: pii = 22.0/7.0 REAL x = 1.0 Answer: ------- The following statements are not according Fortran syntax: CHARACTER(LEN=*), PARAMETER :: "Name" REAL x = 1.0 Note also, that the result of the division 22/7 is truncated so that the result is rounded to an integer closer to zero (integer division). Because 22/7 ~ 3.14 rounding is done to 3. 5. Find out, what are the ranges of the values of integer and real numbers, which the Fortran compiler you use can handle. Hint: study the values which the following subprogram calls return SELECTED_REAL_KIND SELECTED_INT_KIND e.g., by the following way: PROGRAM kindtest IMPLICIT NONE INTEGER :: i, ikind DO i = 1, 24 ikind = SELECTED_INT_KIND(i) WRITE (*,*) 'i = ',i, ' kind = ',ikind END DO END PROGRAM kindtest Please, note that the values of the kind parameter depend on the Fortran compiler used! Answer: ------- PROGRAM kindtest IMPLICIT NONE INTEGER :: i, int_kind, p, r, real_kind DO i = 1, 50 int_kind = SELECTED_INT_KIND(i) WRITE (*,*)'i = ', i, ' kind = ', int_kind END DO DO p = 1, 40 DO r = 1, 101, 10 real_kind = SELECTED_REAL_KIND(p,r) WRITE (*,*) 'p = ', p, 'r = ', r, ' kind = ', real_kind END DO END DO END PROGRAM kindtest NB: Redirect output to a file, e.g.: ./a.out > log 6. What are the iteration counts of the following DO loops, the values of loop variable i inside the loop, and the value of the loop variable after the DO construct? DO i = 1, 5 DO i = 5, 0, -1 DO i = 10, 1, -2 DO i = 0, 30, 7 DO i = 3, 2, 1 Answer: ------- count values i after the loop DO i = 1, 5 5 1,2,3,4,5 6 DO i = 5, 0, -1 6 5,4,3,2,1,0 -1 DO i = 10, 1, -2 5 10,8,6,4,2 0 DO i = 0, 30, 7 5 0,7,14,21,28 35 DO i = 3, 2, 1 0 - 3 PROGRAM behavior_of_loops IMPLICIT NONE INTEGER :: i WRITE(*,*)" ------- loop 1" DO i = 1, 5 WRITE(*,*) i END DO WRITE(*,*)'after loop ',i WRITE(*,*)" ------- loop 2" DO i = 5, 0, -1 WRITE(*,*) i END DO WRITE(*,*)'after loop ',i WRITE(*,*)" ------- loop 3" DO i = 10, 1, -2 WRITE(*,*) i END DO WRITE(*,*)'after loop ', i WRITE(*,*)" ------- loop 4" DO i = 0, 30, 7 WRITE(*,*) i END DO WRITE(*,*)'after loop ',i WRITE(*,*)" ------- loop 5" DO i = 3, 2, 1 WRITE(*,*) i END DO WRITE(*,*)'after loop ',i END PROGRAM behavior_of_loops 7. Write a program that uses a SELECT CASE structure, which does different operations when an integer variable is negative, it is zero, or it is one of the prime numbers (3, 5, 7, 11, 13). In other cases nothing is done. Answer: ------- PROGRAM select_operation INTEGER :: n DO n = -1,14 WRITE (*,*) 'n =', n SELECT CASE(n) CASE(:-1) WRITE (*,*)'MATCH FOUND, n is', n, ' do operation 1' CASE(0) WRITE (*,*)'MATCH FOUND, n is', n, ' do operation 2' CASE(3,5,7,11,13) WRITE (*,*)'MATCH FOUND, n is', n, ' do operation 3' END SELECT END DO END PROGRAM select_operation 8. What is wrong with the following declaration? REAL DIMENSION(1:3,2:3) :: aa Answer: ------- A comma (,) is missing between REAL and DIMENSION keywords. The correct code looks like this: REAL, DIMENSION(1:3,2:3) :: aa Alternatively you can express also as follows: REAL :: aa(1:3,2:3) 9. Write a program that declares an integer array iarray, which contains 3 rows and 4 columns. Initialize the first row with integer values 1 to 4 (from left to right), the second row with integers from 5 to 8, and fill the last row with -2. Then print the iarray row by row so that each output line contains the elements of one row at a time. Answer: ------- PROGRAM ex9 INTEGER, DIMENSION(3,4) :: iarray INTEGER i,j iarray(1,1:4) = (/ (j, j=1,4) /) iarray(2,1:4) = (/ (j, j=5,8) /) iarray(3, : ) = -2 DO i=1,3 PRINT *,iarray(i, : ) END DO END PROGRAM ex9 10. Continuing with the previous example: Build a 3-by-8 integer array bigarray, where the 4 first columns are identical to the iarray , and the 4 last columns are obtained from the columns of the array iarray by multiplying them with the number 3 and adding 5. Use array syntax all the way. Print the bigarray. Answer: ------- PROGRAM ex10 INTEGER, DIMENSION(3,8) :: bigarray INTEGER, DIMENSION(3,4) :: iarray INTEGER i,j iarray(1,1:4) = (/ (j, j=1,4) /) iarray(2,1:4) = (/ (j, j=5,8) /) iarray(3, : ) = -2 bigarray(:,1:4) = iarray(:,:) bigarray(:,5:8) = iarray(:,1:4) * 3 + 5 DO i=1,3 PRINT *,bigarray(i, : ) END DO END PROGRAM ex10 11. Write a DO-loop which sums up the square roots of the given hundred REAL numbers (for example random numbers, in the range of [-r ... r]), but excluding numbers, which are less than 10*EPSILON(0.0). Write two versions: one that uses CYCLE statement and another without it. Store numbers in an array. Write a third version so that it does not use any control structures (IF, DO) for the same task. A hint: Use array syntax. EPSILON() is a machine epsilon function in the Fortran standard and denotes the smallest positive number still greater than zero - in a given floating point precision. Answer: ------- PROGRAM ex11 IMPLICIT NONE INTEGER :: i INTEGER, PARAMETER :: n=100 REAL :: zero_threshold, rsum REAL, DIMENSION(n) :: x ! random values for x CALL RANDOM_SEED() CALL RANDOM_NUMBER(x) ! random values, range [0 1] x=x-0.5 ! shift, new range [-.5 .5] zero_threshold=10*EPSILON(0.0) ! Without CYCLE statement: rsum = 0.0 DO i = 1, n IF ( x(i) >= zero_threshold ) THEN rsum = rsum + SQRT(x(i)) END IF END DO WRITE(*,*)'---Without CYCLE-----' WRITE(*,*) rsum ! With CYCLE statement: rsum = 0.0 DO i = 1, n IF ( x(i) < zero_threshold ) THEN CYCLE END IF rsum = rsum + SQRT(x(i)) END DO WRITE(*,*)'---With CYCLE-----' WRITE(*,*) rsum ! Without control stuctures (array syntax) rsum = 0.0 rsum=SUM(SQRT(x), x >= zero_threshold) WRITE(*,*)'---Array syntax-----' WRITE(*,*)rsum END PROGRAM ex11 12. Modify the source code distance.f95 so that it uses a i) Function ii) Subroutine to calculate distance between a point pair in xy-plane. Extra: Extend the program to accept arrays Answer: ------- Using function: PROGRAM distance_function IMPLICIT NONE REAL :: x1(10),y1(10) REAL :: x2(10),y2(10) REAL :: dist(10) INTEGER :: i ! define point pairs x1=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) y1=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) x2=(/11., 22., 33., 44., 55., 66., 77., 88., 99., 110./) y2=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) ! do loop way WRITE(*,*)'Distances calculated using do loop' DO i=1,10 dist(i)=SQRT((x2(i)-x1(i))**2+(y2(i)-y1(i))**2) WRITE(*,*) dist(i) END DO ! Calling a function dist=distance(x1,y1,x2,y2) DO i=1,10 WRITE(*,*) dist(i) END DO CONTAINS FUNCTION distance(ax,ay,bx,by) RESULT(dd) REAL :: ax(:) REAL :: ay(:) REAL :: bx(:) REAL :: by(:) REAL :: dd(SIZE(ax)) INTEGER :: dim,j dim=SIZE(ay) DO j=1,dim dd(j)=SQRT((bx(j)-ax(j))**2+(by(j)-ay(j))**2) END DO END FUNCTION distance END PROGRAM distance_function Using a subroutine: PROGRAM distance_subroutine IMPLICIT NONE REAL :: x1(10),y1(10) REAL :: x2(10),y2(10) REAL :: dist(10) INTEGER :: i ! define point pairs x1=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) y1=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) x2=(/11., 22., 33., 44., 55., 66., 77., 88., 99., 110./) y2=(/1., 2., 3., 4., 5., 6., 7., 8., 9., 10./) ! do loop way WRITE(*,*)'Distances calculated using do loop' DO i=1,10 dist(i)=SQRT((x2(i)-x1(i))**2+(y2(i)-y1(i))**2) WRITE(*,*) dist(i) END DO WRITE(*,*)'Distances calculated using subroutine' ! Calling a subroutine CALL distance(x1,y1,x2,y2,dist) DO i=1,10 WRITE(*,*) dist(i) END DO CONTAINS SUBROUTINE distance(ax,ay,bx,by,dx) REAL :: ax(:) REAL :: ay(:) REAL :: bx(:) REAL :: by(:) REAL :: dx(SIZE(ax)) INTEGER :: dim,j dim=SIZE(ay) DO j=1,dim dx(j)=SQRT((bx(j)-ax(j))**2+(by(j)-ay(j))**2) END DO END SUBROUTINE distance END PROGRAM distance_subroutine 13. Write a module which declares the kind type parameter for double precision real number. Answer: MODULE kind IMPLICIT NONE INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(12) ! INTEGER, PARAMETER :: reaaliluku = SELECTED_REAL_KIND(6) END MODULE kind 14. - 17. Continuing with the previous example: Write a module which sums up two real numbers and a main program, which uses the module. Use the module of Exercise 13 for defining precision of the main program and the summing function. Instead of module, make a program that uses an external procedure (function) to sum up two real numbers. Try to figure out the weakness of this approach. Modify the program such that it uses an internal procedure (function) to sum up two real numbers. Change the another addend to integer in the summing functions defined in module, external function or internal function (one by one). Compile and run the program. What happens? Answer: ------- ! Module: MODULE sum_mod USE kind IMPLICIT NONE CONTAINS FUNCTION summing(a,b) RESULT(c) REAL(dp),INTENT(IN)::a,b REAL(dp)::c c=a+b END FUNCTION summing END MODULE sum_mod ! External function: FUNCTION summing_ext(a,b) RESULT (c) IMPLICIT NONE REAL::a,b,c c=a+b END FUNCTION summing_ext !Main program PROGRAM sums USE kind ! this is a module that defines precision db USE sum_mod ! this is a module for computing the sum IMPLICIT NONE REAL(dp)::x,z INTEGER::y ! this is an external function for computing the sum REAL,EXTERNAL::summing_ext ! we give values for variables x=16330.0_dp z=55.0_dp y=55 WRITE (*,*),'Internal function' WRITE (*,*),'sum of ',x,z,' is ',sumfunc(x,z) WRITE (*,*),'Module implementation' WRITE (*,*),'sum of ',x,z,' is ',summing(x,z) WRITE (*,*),'External function' WRITE (*,*),'sum of ',x,z,' is ',summing_ext(x,z) WRITE (*,*),'External function with integer' WRITE (*,*),'sum of ',x,y,' is ',summing_ext(x,y) WRITE (*,*),'As we can see summing of real and integer in external& & function will not give us the right answer' ! WRITE (*,*),'Module implementation' ! WRITE (*,*),'sum of ',x,y,' is ',summing(x,y) CONTAINS FUNCTION sumfunc(a,b) RESULT(c) IMPLICIT NONE REAL(dp)::a,b,c c=a+b END FUNCTION sumfunc END PROGRAM sums In module version, you would get compiler error when the other addend is an integer. 18. Compile and run program squaresum.f95. Program should calculate the sum of squares of consecutive calls. Correct the code for mistakes. Answer: ------- Variable sqsu must be defined as SAVE variable for it to be saved between calls. By defining value at initialisation the variable is considered saved by default. One could also include ,SAVE in the statement. However, this is not enough as during the first call sqsu doesn't have value and is possible to make all values after that abnormal. (I could not produce an example, though) PROGRAM squaresum_a IMPLICIT NONE WRITE (*,*) 'Result: ', sqsum(1.0) WRITE (*,*) 'Result: ', sqsum(2.0) WRITE (*,*) 'Result: ', sqsum(5.0) CONTAINS REAL FUNCTION sqsum(x) IMPLICIT NONE REAL, INTENT(IN) :: x REAL :: sqsu = 0.0 ! REAL,SAVE :: sqsu= 0.0 sqsu = x**2+sqsu sqsum = sqsu END FUNCTION sqsum END PROGRAM squaresum 19. Write a program that declares an allocatable REAL array: one-dimensional with 2*N elements, filled with values from 1 to 2*N in consecutive locations. Print the SUM of the array element and deallocate array. Set N to 10. Answer: ------- PROGRAM ex19 IMPLICIT NONE INTEGER :: n, j, istat REAL, ALLOCATABLE, DIMENSION(:) :: array n = 10 ALLOCATE(array(2*n),stat=istat) IF (istat /= 0) THEN PRINT *,'Allocation of array(2*n) failed. n=',n,', istat=',istat CALL abort() END IF array = (/ (j, j=1,2*n) /) PRINT *,'SUM(array) = ',SUM(array) DEALLOCATE(array) END PROGRAM ex19 20. Continuing with the previous example. Add two dimensional allocatable N-by-2 REAL array and fill it with one-dimensional array's values using RESHAPE. Answer: ------- PROGRAM ex20 IMPLICIT NONE INTEGER :: n, j, istat REAL, ALLOCATABLE, DIMENSION(:) :: array REAL, ALLOCATABLE, DIMENSION(:,:) :: array2d n = 10 ALLOCATE(array(2*n),stat=istat) IF (istat /= 0) THEN PRINT *,'Allocation of array(2*n) failed. n=',n,', istat=',istat CALL abort() END IF array = (/ (j, j=1,2*N) /) PRINT *,'SUM(array) = ',SUM(array) ALLOCATE(array2d(n,2),stat=istat) IF (istat /= 0) THEN PRINT *,'Allocation of array2d(n,2) failed. n=',n,', istat=',istat CALL abort() END IF array2d = RESHAPE(array, (/ n, 2 /)) DEALLOCATE(array) PRINT *,'SUM(array2d) = ',SUM(array2d) DEALLOCATE(array2d) END PROGRAM ex20 21. Write a subroutine which performs like the previous example, but takes the array size-dimension N as an argument and uses automatic array technique to allocate the memory for the arrays. Answer: ------- PROGRAM ex21 IMPLICIT NONE INTEGER :: n n = 10 CALL automatic_alloc(N) CONTAINS SUBROUTINE automatic_alloc(N) IMPLICIT NONE INTEGER, INTENT(IN) :: n INTEGER :: j REAL, DIMENSION(2*n) :: array REAL, DIMENSION(n,2) :: array2d array = (/ (j, j=1,2*n) /) PRINT *,'SUM(array) = ',SUM(array) array2d = RESHAPE(array, (/ N, 2 /)) PRINT *,'SUM(array2d) = ',SUM(array2d) END SUBROUTINE automatic_alloc END PROGRAM ex21 22. Declare the derived type which can save the birth date in the following form: 21 01 1990 This derived type thus contains three integers, which have different KIND values: SELECTED_INT_KIND(2) and SELECTED_INT_KIND(4). Answer: ------- MODULE personal IMPLICIT NONE TYPE bday INTEGER(SELECTED_INT_KIND(2))::dd,mm INTEGER(SELECTED_INT_KIND(4))::yyyy END TYPE bday END MODULE personal PROGRAM bdaytest USE personal IMPLICIT NONE TYPE(bday)::date ! Assign value for date of birthday date=bday(10,01,1999) ! Write the values out WRITE(*,*) date END PROGRAM bdaytest 24. Add the field the for the name to the derived type of the previous exercise. Write a function, which returns the name and date in a character string in the following form: Charlie Brown (01.01.1999) Answer: ------- File CharlieBrown has main program defining one variable to store the user Charlie Brown. Module personal_ext has the modified datatype with definitions for birthday and name as well as function to output the information stored by the datatype. MODULE personal_ext IMPLICIT NONE TYPE p_data INTEGER(SELECTED_INT_KIND(2))::dd,mm INTEGER(SELECTED_INT_KIND(4))::yyyy CHARACTER (20)::firstname Character(20)::lastname END TYPE p_data CONTAINS SUBROUTINE print_data(record) TYPE(p_data)::record INTEGER::llen,flen WRITE(*,'(A8,A8,A,I2,A,I2,A,I4,A)') record%firstname,record%lastname,& ' (',record%dd,'.',record%mm,'.',record%yyyy,')' end subroutine print_data END MODULE personal_ext PROGRAM charliebrown USE personal_ext IMPLICIT NONE ! define a variable with our datatype p_data TYPE(p_data):: user ! First create user named Charlie Brown with a birthday 11.12.1990 user=p_data(11,12,1990,'Charlie','Brown') ! Then printout data in two ways PRINT*,'This is how it looks by just outputting the variables' PRINT*,user PRINT*, 'This is how it looks by using our function print_data' CALL print_data(user) END PROGRAM charliebrown 24. In the following there are declared Fortran format statements in various ways. What the program does? Which declarations are most functional? PROGRAM form IMPLICIT NONE REAL :: x CHARACTER(LEN=11) :: form1 CHARACTER(LEN=*), PARAMETER :: form2 = '(F12.3,A)' x = 12.0 form1 = '(F12.3,A)' WRITE (*, form1) x, ' hello ' WRITE (*, form2) 2*x, ' hi ' WRITE (*, '(F12.3,A)') 3*x, ' hi hi ' END PROGRAM form Answer: ------- The program prints: 12.000 hello 24.000 hi 36.000 hi hi Character string constants were used in the program with different ways for giving format codes. Declaration of character string constants is easy but their values cannot be changed afterwards. On the other hand, initialization of character string variables is more tedious. If there is run time formatting needs then CHARACTER(LEN=11) :: form1 is the best way. 25. Write output statements for the following arrays: REAL, DIMENSION(6,10) :: a INTEGER, DIMENSION(24) :: h CHARACTER(LEN=10), DIMENSION(6) :: marray LOGICAL, DIMENSION(2) :: condition COMPLEX, DIMENSION(20) :: z Answer: ------- Here we have some alternatives: Basic list directed output: WRITE(*,*) [name_of_the_variable] Formatted examples: WRITE(*,'(6F8.4)') a ! prints a 6 x 10 matrix ! reversed order for mathematical matrices WRITE(*,'(F8.4)') a ! prints a column vector ! next loop will print 6 x 10 matrix in mathematical order DO j=1,6 WRITE (*,'(10(F8.4,1X))' ) a(j,:) END DO WRITE(*,'(4I5)') H ! prints a 6 x 4 matrix WRITE(*,'(A)') MARRAY ! words below each other WRITE(*,'(3A10)') MARRAY ! 2 rows, 3 words per row WRITE(*,'(L7)') CONDITION ! truth values below each other WRITE(*,'(F8.4,F8.4)') Z ! complex numbers below each other WRITE(*,'(F8.4,F8.4,5X,F8.4,F8.4)') Z ! two alongside WRITE(*,'(3F8.4,3F8.4)') Z ! three alongside WRITE(*,'(6F8.4)') Z ! three alongside