├── .gitattributes ├── .gitignore ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md └── src ├── ch01 ├── Makefile ├── array_copy_caf.f90 ├── array_copy_mpi.f90 └── hello_coarrays.f90 ├── ch02 ├── Makefile ├── data_types.f90 └── hello.f90 ├── ch03 ├── Makefile ├── add_subroutine.f90 ├── cold_front_elemental.f90 ├── cold_front_function.f90 ├── cold_front_program.f90 ├── example_elemental.f90 ├── hello_function.f90 ├── optional_arguments.f90 ├── sum_function_v1.f90 ├── sum_function_v2.f90 └── sum_function_v3.f90 ├── ch06 ├── Makefile ├── dashboard.f90 ├── echo_robot.f90 ├── qn.f90 ├── read_write.f90 ├── read_write_list.f90 ├── read_write_list_formatted.f90 ├── redirect_stdout_to_file.f90 ├── standard_streams.f90 └── write_pi_to_text_and_binary.f90 ├── ch07 ├── Makefile ├── coarrays.f90 ├── hello_images.f90 └── hello_images_ordered.f90 ├── ch08 ├── Makefile ├── banking_app_example.f90 ├── derived_type_constructor.f90 ├── derived_type_init.f90 ├── hello_derived_types.f90 └── hello_derived_types_elemental.f90 ├── ch09 ├── Makefile ├── average_generic.f90 ├── average_incompatible.f90 └── strcat.f90 └── ch10 ├── average_generic.f90 ├── mod_average_incompatible.f90 └── strcat.f90 /.gitattributes: -------------------------------------------------------------------------------- 1 | .gitattributes text eol=lf 2 | .gitignore text eol=lf 3 | Makefile text eol=lf 4 | *.yml text eol=lf 5 | LICENSE text eol=lf 6 | *.ipynb text eol=lf 7 | *.txt text eol=lf 8 | *.py text eol=lf 9 | *.sh text eol=lf 10 | *.c text eol=lf 11 | *.cpp text eol=lf 12 | *.f text eol=lf 13 | *.for text eol=lf 14 | *.f90 text eol=lf 15 | *.md text eol=lf 16 | *.rst text eol=lf 17 | *.csv text eol=lf 18 | *.m text eol=lf 19 | *.grc text eol=lf 20 | *.pas text eol=lf 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | array_copy_mpi 2 | array_copy_caf 3 | 4 | # Prerequisites 5 | *.d 6 | 7 | # Compiled Object files 8 | *.slo 9 | *.lo 10 | *.o 11 | *.obj 12 | 13 | # Precompiled Headers 14 | *.gch 15 | *.pch 16 | 17 | # Compiled Dynamic libraries 18 | *.so 19 | *.dylib 20 | *.dll 21 | 22 | # Fortran module files 23 | *.mod 24 | *.smod 25 | 26 | # Compiled Static libraries 27 | *.lai 28 | *.la 29 | *.a 30 | *.lib 31 | 32 | # Executables 33 | *.exe 34 | *.out 35 | *.app 36 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: none 2 | fast_finish: true 3 | 4 | os: 5 | - linux 6 | - osx 7 | 8 | env: FC=gfortran 9 | 10 | dist: trusty 11 | group: edge 12 | 13 | notifications: 14 | email: false 15 | 16 | git: 17 | depth: 3 18 | 19 | addons: 20 | apt: 21 | sources: ['ubuntu-toolchain-r-test'] 22 | packages: ['gfortran','libopenmpi-dev','openmpi-bin'] 23 | 24 | before_install: 25 | - if [[ $TRAVIS_OS_NAME == osx ]]; then 26 | brew update; 27 | brew install gcc || brew upgrade gcc || brew link --overwrite gcc; 28 | brew install open-mpi; 29 | brew install opencoarrays; 30 | fi 31 | 32 | install: 33 | - make -k || true 34 | 35 | script: 36 | - mpirun -n 2 src/ch01/array_copy_mpi 37 | # FIXME: Ubuntu 14.04 is too old for opencoarrays. Would Linuxbrew work? 38 | - if [[ $TRAVIS_OS_NAME == osx ]]; then 39 | cafrun -n 2 src/ch01/array_copy_caf; 40 | cafrun -n 2 src/ch01/hello_coarrays; 41 | fi 42 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017-2020 Milan Curcic 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Modern Fortran -- Miscellaneous Listings 2 | 3 | .PHONY: all clean 4 | 5 | all: ch01 ch02 ch03 ch06 ch07 ch08 ch09 6 | 7 | %: 8 | $(MAKE) --directory=src/$@ 9 | 10 | clean: 11 | $(MAKE) --directory=src/ch01 clean 12 | $(MAKE) --directory=src/ch02 clean 13 | $(MAKE) --directory=src/ch03 clean 14 | $(MAKE) --directory=src/ch06 clean 15 | $(MAKE) --directory=src/ch07 clean 16 | $(MAKE) --directory=src/ch08 clean 17 | $(MAKE) --directory=src/ch09 clean 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # listings 2 | 3 | [![Build Status](https://travis-ci.org/modern-fortran/listings.svg?branch=master)](https://travis-ci.org/modern-fortran/listings) 4 | [![GitHub issues](https://img.shields.io/github/issues/modern-fortran/listings.svg)](https://github.com/modern-fortran/listings/issues) 5 | 6 | Code listings for [Modern Fortran: Building Efficient Parallel Applications](https://www.manning.com/books/modern-fortran?a_aid=modernfortran&a_bid=2dc4d442). 7 | 8 | ## Getting started 9 | 10 | To build and run the examples on your local machine, get the code using git: 11 | 12 | ```sh 13 | git clone https://github.com/modern-fortran/listings 14 | cd listings 15 | make -k 16 | ``` 17 | 18 | -k 19 | : continue to `make` even if one command fails (for those that don't have `caf` compiler wrapper, for example). 20 | 21 | or, you can select to make particular programs by: 22 | ```sh 23 | make array_copy_mpi 24 | ``` 25 | 26 | ### Linux 27 | Get the `mpif90` compiler wrapper on Ubuntu ≥ 12.04: 28 | ```sh 29 | apt install libopenmpi-dev openmpi-bin gfortran 30 | ``` 31 | 32 | Get the `caf` compiler wrapper on Ubuntu ≥ 17.04: 33 | ```sh 34 | apt install open-coarrays-bin 35 | ``` 36 | 37 | ### Mac 38 | ```sh 39 | brew install gcc open-mpi 40 | ``` 41 | 42 | ## Run 43 | 44 | ```sh 45 | mpirun -n 2 ./array_copy_mpi 46 | ``` 47 | 48 | ## Problems? 49 | 50 | See the list of already open [issues](https://github.com/modern-fortran/listings/issues). 51 | If you can't find your issue, open a [new issue](https://github.com/modern-fortran/listings/issues/new). 52 | 53 | ## Acknowledgements 54 | 55 | Big thank you to contributors: 56 | 57 | * [Izaak Beekman](https://github.com/zbeekman) 58 | * [Michael Hirsch](https://github.com/scivision) 59 | -------------------------------------------------------------------------------- /src/ch01/Makefile: -------------------------------------------------------------------------------- 1 | CAF = caf 2 | MPI = mpif90 3 | 4 | .PHONY: all clean 5 | 6 | all: hello_coarrays array_copy_mpi array_copy_caf 7 | 8 | hello_coarrays: hello_coarrays.f90 9 | $(CAF) $< -o $@ 10 | 11 | array_copy_mpi: array_copy_mpi.f90 12 | $(MPI) $< -o $@ 13 | 14 | array_copy_caf: array_copy_caf.f90 15 | $(CAF) $< -o $@ 16 | 17 | clean: 18 | $(RM) hello_coarrays array_copy_mpi array_copy_caf 19 | 20 | -------------------------------------------------------------------------------- /src/ch01/array_copy_caf.f90: -------------------------------------------------------------------------------- 1 | program array_copy_caf 2 | ! Example of sending/receiving an array of integers using coarrays. 3 | ! Listing 1.3 in the book. 4 | implicit none 5 | 6 | integer :: array(5)[*] = 0 7 | integer, parameter :: sender = 1, receiver = 2 8 | 9 | if (num_images() /= 2) & 10 | error stop 'Error: This program must be run on 2 parallel processes' 11 | 12 | if (this_image() == sender) array = [1, 2, 3, 4, 5] 13 | 14 | print '(a,i2,a,5(4x,i2))', & 15 | 'array on proc ', this_image(), ' before copy:', array 16 | 17 | sync all 18 | 19 | if (this_image() == receiver) array(:) = array(:)[sender] 20 | 21 | print '(a,i2,a,5(4x,i2))', & 22 | 'array on proc ', this_image(), ' after copy: ', array 23 | 24 | end program array_copy_caf 25 | -------------------------------------------------------------------------------- /src/ch01/array_copy_mpi.f90: -------------------------------------------------------------------------------- 1 | program array_copy_mpi 2 | ! Example of sending/receiving an array of integers using MPI. 3 | ! Listing 1.2 in the book. 4 | use mpi 5 | implicit none 6 | 7 | integer :: ierr, nproc, procsize, request 8 | integer :: stat(mpi_status_size) 9 | 10 | integer :: array(5) = 0 11 | integer, parameter :: sender = 0, receiver = 1 12 | 13 | call mpi_init(ierr) 14 | call mpi_comm_rank(mpi_comm_world, nproc, ierr) 15 | call mpi_comm_size(mpi_comm_world, procsize, ierr) 16 | 17 | if (procsize /= 2) then 18 | call mpi_finalize(ierr) 19 | error stop 'Error: This program must be run on 2 parallel processes' 20 | end if 21 | 22 | if (nproc == sender) array = [1, 2, 3, 4, 5] 23 | 24 | print '(a,i2,a,5(4x,i2))', 'array on proc ', nproc, ' before copy:', array 25 | 26 | call mpi_barrier(mpi_comm_world, ierr) 27 | 28 | if (nproc == sender) then 29 | call mpi_isend(array, size(array), mpi_int, receiver, 1, & 30 | mpi_comm_world, request, ierr) 31 | else if (nproc == receiver) then 32 | call mpi_irecv(array, size(array), mpi_int, sender, 1, & 33 | mpi_comm_world, request, ierr) 34 | call mpi_wait(request, stat, ierr) 35 | end if 36 | 37 | print '(a,i2,a,5(4x,i2))', 'array on proc ', nproc, ' after copy: ', array 38 | 39 | call mpi_finalize(ierr) 40 | 41 | end program array_copy_mpi 42 | -------------------------------------------------------------------------------- /src/ch01/hello_coarrays.f90: -------------------------------------------------------------------------------- 1 | program hello_coarrays 2 | ! A coarray variant of a hello world program. 3 | ! Listing 1.1 in the book. 4 | implicit none 5 | 6 | integer :: a[*] 7 | integer :: i 8 | 9 | a = this_image() 10 | 11 | if (this_image() == 1) then 12 | do i = 1, num_images() 13 | print *, 'Value on image', i, 'is', a[i] 14 | end do 15 | end if 16 | 17 | end program hello_coarrays 18 | -------------------------------------------------------------------------------- /src/ch02/Makefile: -------------------------------------------------------------------------------- 1 | FC = gfortran 2 | 3 | PROGRAMS = hello data_types 4 | 5 | .PHONY: all clean 6 | 7 | all: ${PROGRAMS} 8 | 9 | %: %.f90 10 | $(FC) $< -o $@ 11 | 12 | clean: 13 | $(RM) ${PROGRAMS} 14 | -------------------------------------------------------------------------------- /src/ch02/data_types.f90: -------------------------------------------------------------------------------- 1 | program data_types 2 | 3 | ! This program prints the maximum values for intrinsic integer data types, 4 | ! and minimum and maximum values for intrinsic real data types. 5 | 6 | use iso_fortran_env, only: int8, int16, int32, int64, real32, real64, real128 7 | 8 | implicit none 9 | 10 | integer(int8) :: i8 11 | integer(int16) :: i16 12 | integer(int32) :: i32 13 | integer(int64) :: i64 14 | 15 | real(real32) :: r32 16 | real(real64) :: r64 17 | real(real128) :: r128 18 | 19 | print *, 'This program prints the range of standard integer & 20 | and real kinds available in iso_fortran_env' 21 | 22 | print *, 'Largest int8: ', huge(i8) 23 | print *, 'Largest int16: ', huge(i16) 24 | print *, 'Largest int32: ', huge(i32) 25 | print *, 'Largest int64: ', huge(i64) 26 | 27 | print *, 'Smallest/largest real32: ', tiny(r32), huge(r32) 28 | print *, 'Smallest/largest real64: ', tiny(r64), huge(r64) 29 | print *, 'Smallest/largest real128: ', tiny(r128), huge(r128) 30 | 31 | end program data_types 32 | -------------------------------------------------------------------------------- /src/ch02/hello.f90: -------------------------------------------------------------------------------- 1 | program hello 2 | ! Hello world of Fortran. 3 | ! This is Listing 2.1 in the book. 4 | print *, 'Hello world!' 5 | end program hello 6 | -------------------------------------------------------------------------------- /src/ch03/Makefile: -------------------------------------------------------------------------------- 1 | FC = gfortran 2 | 3 | PROGRAMS = cold_front_program \ 4 | cold_front_function \ 5 | cold_front_elemental \ 6 | hello_function \ 7 | example_elemental \ 8 | optional_arguments 9 | 10 | .PHONY: all clean 11 | 12 | all: ${PROGRAMS} 13 | 14 | %: %.f90 15 | $(FC) $< -o $@ 16 | 17 | clean: 18 | $(RM) ${PROGRAMS} 19 | -------------------------------------------------------------------------------- /src/ch03/add_subroutine.f90: -------------------------------------------------------------------------------- 1 | subroutine add(a, b, res) 2 | ! Example Fortran subroutine. 3 | ! Listing 3.13 in the book. 4 | integer, intent(in) :: a, b 5 | integer, intent(out) :: res 6 | res = a + b 7 | end subroutine add 8 | -------------------------------------------------------------------------------- /src/ch03/cold_front_elemental.f90: -------------------------------------------------------------------------------- 1 | program cold_front 2 | ! This program calculates temperature due to cold front 3 | ! passage for different times using an external elemental 4 | ! function. 5 | ! Listing 3.25 in the book. 6 | implicit none 7 | real :: nhours(8) = [6., 12., 18., 24., 30., 36., 42., 48.] 8 | real :: temp1(8) = 12 9 | real :: temp2(8) = 24 10 | real :: c(8) = 20 11 | real :: dx(8) = 960 12 | 13 | print *, cold_front_temperature(temp1, temp2, c, dx, nhours) 14 | 15 | contains 16 | 17 | real pure elemental function cold_front_temperature( & 18 | temp1, temp2, c, dx, dt) result(res) 19 | ! Returns the temperature after dt hours, given initial 20 | ! temperatures at origin (temp1) and destination (temp2), 21 | ! front speed (c), and distance between the two locations (dx). 22 | ! Works with input scalars or arrays. 23 | real, intent(in) :: temp1, temp2, c, dx, dt 24 | res = temp2 - c * (temp2 - temp1) / dx * dt 25 | end function cold_front_temperature 26 | 27 | end program cold_front 28 | -------------------------------------------------------------------------------- /src/ch03/cold_front_function.f90: -------------------------------------------------------------------------------- 1 | program cold_front 2 | ! This program calculates temperature due to cold front 3 | ! passage for different times using an external function. 4 | ! Listing 3.3 in the book. 5 | implicit none 6 | 7 | integer :: n 8 | real :: nhours 9 | 10 | do n = 6, 48, 6 11 | nhours = real(n) 12 | print *, 'Temparature after ', nhours, ' hours is ', & 13 | cold_front_temperature(12., 24., 20., 960., nhours), & 14 | ' degrees.' 15 | end do 16 | 17 | contains 18 | 19 | real function cold_front_temperature(temp1, temp2, c, dx, dt) result(r) 20 | ! Returns the temperature after dt hours, given initial 21 | ! temperatures at origin (temp1) and destination (temp2), 22 | ! front speed (c), and distance between the two locations (dx). 23 | real, intent(in) :: temp1, temp2, c, dx, dt 24 | r = temp2 - c * (temp2 - temp1) / dx * dt 25 | end function cold_front_temperature 26 | 27 | end program cold_front 28 | -------------------------------------------------------------------------------- /src/ch03/cold_front_program.f90: -------------------------------------------------------------------------------- 1 | program cold_front 2 | ! This program calculates the temperature after nhours, 3 | ! given initial temperatures at two locations, distance 4 | ! between the two locations, and front speed. 5 | ! Listing 3.2 in the book. 6 | implicit none 7 | 8 | real :: temp1 = 12 ! temperature at origin in deg. C 9 | real :: temp2 = 24 ! temperature at destination in deg. C 10 | real :: dx = 960 ! distance in km 11 | real :: c = 20 ! front speed in km per hour 12 | real :: dt = 24 ! time interval in hours 13 | 14 | real :: res ! result in deg. C 15 | 16 | res = temp2 - c * (temp2 - temp1) / dx * dt 17 | 18 | print *, 'Temparature after ', dt, & 19 | 'hours is ', res, 'degrees.' 20 | 21 | end program cold_front 22 | -------------------------------------------------------------------------------- /src/ch03/example_elemental.f90: -------------------------------------------------------------------------------- 1 | program example_elemental 2 | ! Example of calling an elemental function 3 | ! with scalars or arrays as arguments. 4 | ! Listing 3.20 in the book. 5 | implicit none 6 | 7 | print *, sum(3, 5) 8 | print *, sum([1, 2], 3) 9 | print *, sum(1, [2, 3, 4]) 10 | print *, sum([1, 2, 3], [2, 3, 4]) 11 | 12 | ! uncomment the line below to trigger compiler error 13 | ! print *, sum([1, 2], [2, 3, 4]) 14 | 15 | contains 16 | 17 | pure elemental integer function sum(a, b) result(r) 18 | integer, intent(in) :: a, b 19 | r = a + b 20 | end function sum 21 | 22 | end program example_elemental 23 | -------------------------------------------------------------------------------- /src/ch03/hello_function.f90: -------------------------------------------------------------------------------- 1 | program hello 2 | ! Minimal example of calling a function. 3 | implicit none 4 | 5 | print *, greeting() 6 | 7 | contains 8 | 9 | function greeting() 10 | character(len=5) :: greeting 11 | greeting = 'hello' 12 | end function greeting 13 | 14 | end program hello 15 | -------------------------------------------------------------------------------- /src/ch03/optional_arguments.f90: -------------------------------------------------------------------------------- 1 | program optional_arguments 2 | ! Example of optional arguments. 3 | ! Listing 3.21 in the book. 4 | implicit none 5 | 6 | integer :: res 7 | 8 | call add(3, 5, res) 9 | call add(3, 5, res, .true.) 10 | call add(3, 5, res, debug=.true.) 11 | 12 | contains 13 | 14 | subroutine add(a, b, res, debug) 15 | integer, intent(in) :: a, b 16 | integer, intent(out) :: res 17 | logical, intent(in), optional :: debug 18 | 19 | if (present(debug)) then 20 | if (debug) then 21 | print *, 'DEBUG: subroutine add, a = ', a 22 | print *, 'DEBUG: subroutine add, b = ', b 23 | end if 24 | end if 25 | 26 | res = a + b 27 | if (present(debug)) then 28 | if (debug) print *, 'DEBUG: subroutine add, res = ', res 29 | end if 30 | 31 | end subroutine add 32 | 33 | end program optional_arguments 34 | -------------------------------------------------------------------------------- /src/ch03/sum_function_v1.f90: -------------------------------------------------------------------------------- 1 | function sum(a, b) 2 | ! An example Fortran function. 3 | ! Listing 3.4 in the book. 4 | integer, intent(in) :: a 5 | integer, intent(in) :: b 6 | integer :: sum 7 | sum = a + b 8 | end function sum 9 | -------------------------------------------------------------------------------- /src/ch03/sum_function_v2.f90: -------------------------------------------------------------------------------- 1 | integer function sum(a, b) 2 | ! Version 2 of the example sum function. 3 | ! Listing 3.5 in the book. 4 | integer, intent(in) :: a, b 5 | sum = a + b 6 | end function sum 7 | -------------------------------------------------------------------------------- /src/ch03/sum_function_v3.f90: -------------------------------------------------------------------------------- 1 | integer function sum(a, b) result(res) 2 | ! Version 3 of the example sum function. 3 | ! Listing 3.6 in the book. 4 | integer, intent(in) :: a, b 5 | res = a + b 6 | end function sum 7 | -------------------------------------------------------------------------------- /src/ch06/Makefile: -------------------------------------------------------------------------------- 1 | FC = gfortran 2 | 3 | PROGRAMS = echo_robot \ 4 | read_write \ 5 | read_write_list \ 6 | read_write_list_formatted \ 7 | standard_streams \ 8 | dashboard \ 9 | qn \ 10 | redirect_stdout_to_file \ 11 | write_pi_to_text_and_binary 12 | 13 | .PHONY: all clean 14 | 15 | all: ${PROGRAMS} 16 | 17 | %: %.f90 18 | $(FC) $< -o $@ 19 | 20 | clean: 21 | $(RM) ${PROGRAMS} 22 | -------------------------------------------------------------------------------- /src/ch06/dashboard.f90: -------------------------------------------------------------------------------- 1 | program dashboard 2 | ! Example of formatting data as text. 3 | ! Listing 6.9 in the book. 4 | use iso_fortran_env, only: dash => output_unit 5 | implicit none 6 | 7 | real :: lat = 59.329444, lon = 18.068611, alt = 11678.3 8 | integer :: eng(4) = 96 9 | logical :: airborne = .true. 10 | 11 | character(len=:), allocatable :: dashfmt 12 | 13 | dashfmt = '(2(f9.5, 2x), f7.1, 2x, 4(i3.3, 2x), l)' 14 | write (dash, dashfmt) lat, lon, alt, eng, airborne 15 | 16 | end program dashboard 17 | -------------------------------------------------------------------------------- /src/ch06/echo_robot.f90: -------------------------------------------------------------------------------- 1 | program echo_robot 2 | ! A program that echoes back the text from stdin to stdout. 3 | ! Listing 6.2 in the book. 4 | implicit none 5 | character(len=1000) :: text 6 | read *, text 7 | print *, trim(text) 8 | end program echo_robot 9 | -------------------------------------------------------------------------------- /src/ch06/qn.f90: -------------------------------------------------------------------------------- 1 | program qn 2 | use iso_fortran_env, only: stdin => input_unit, & 3 | stdout => output_unit, & 4 | stderr => error_unit 5 | implicit none 6 | integer :: fileunit, stat 7 | character(len=9999) :: filename, text 8 | character(len=6) :: pos 9 | logical :: file_exists 10 | 11 | if (command_argument_count() < 1) stop 'Usage: qn ' 12 | call get_command_argument(1, filename) 13 | 14 | inquire(file=trim(filename), exist=file_exists) 15 | pos = 'rewind' 16 | 17 | if (file_exists) then 18 | write(stdout, '(a)') 'File ' // trim(filename) // ' already exists!' 19 | do 20 | write(*, '(a)', advance='no') '[O]verwrite, [A]ppend, [Q]uit: ' 21 | read(stdin, '(a)') text 22 | if (any(trim(text) == ['O', 'o'])) then 23 | write(stdout, '(a)') 'Overwriting ' // trim(filename) 24 | exit 25 | elseif (any(trim(text) == ['A', 'a'])) then 26 | pos = 'append' 27 | write(stdout, '(a)') 'Appending to ' // trim(filename) 28 | exit 29 | elseif (any(trim(text) == ['Q', 'q'])) then 30 | stop 31 | end if 32 | end do 33 | end if 34 | 35 | open(newunit=fileunit, file=trim(filename),& 36 | action='write', position=pos) 37 | 38 | do 39 | read(stdin, '(a)', iostat=stat, err=100) text 40 | write(fileunit, '(a)', iostat=stat, err=100) trim(text) 41 | flush(fileunit, iostat=stat, err=100) 42 | end do 43 | 44 | 100 close(fileunit) 45 | if (stat > 0) then 46 | write(stderr, '(a, i3)') 'Error encoutered, code = ', stat 47 | stop 48 | end if 49 | 50 | end program qn 51 | -------------------------------------------------------------------------------- /src/ch06/read_write.f90: -------------------------------------------------------------------------------- 1 | program read_write 2 | ! Reading from stdin and writing to stdout. 3 | implicit none 4 | character(len=100) :: text 5 | read '(a)', text 6 | print '(a)', trim(text) 7 | end program read_write 8 | -------------------------------------------------------------------------------- /src/ch06/read_write_list.f90: -------------------------------------------------------------------------------- 1 | program read_write_list 2 | ! Example of list-directed I/O. 3 | ! Listing 6.4 in the book. 4 | implicit none 5 | character(len=1000) :: text 6 | integer :: a 7 | real :: x 8 | read *, text, a, x 9 | print *, 'User typed: ', trim(text), a, x 10 | end program read_write_list 11 | -------------------------------------------------------------------------------- /src/ch06/read_write_list_formatted.f90: -------------------------------------------------------------------------------- 1 | program read_write_list_formatted 2 | ! Example of list-directed I/O with formatting. 3 | implicit none 4 | character(len=1000) :: text 5 | character(len=:), allocatable :: fmt_string 6 | integer :: a 7 | real :: x 8 | read *, text, a, x 9 | fmt_string = '(2a, 1x, i2, 1x, f5.3)' 10 | print fmt_string, 'User typed: ', trim(text), a, x 11 | end program read_write_list_formatted 12 | -------------------------------------------------------------------------------- /src/ch06/redirect_stdout_to_file.f90: -------------------------------------------------------------------------------- 1 | program redirect_stdout_to_file 2 | ! Redirecting standard output to a file. 3 | ! Listing 6.27 in the book. 4 | use iso_fortran_env, only: stdout => output_unit, & 5 | stderr => error_unit 6 | implicit none 7 | 8 | open(unit=stdout, file='log.out') 9 | open(unit=stderr, file='log.err') 10 | 11 | write(stdout, *) 'This goes to stdout.' 12 | write(stderr, *) 'This goes to stderr.' 13 | 14 | close(stdout) 15 | close(stderr) 16 | 17 | end program redirect_stdout_to_file 18 | -------------------------------------------------------------------------------- /src/ch06/standard_streams.f90: -------------------------------------------------------------------------------- 1 | program standard_streams 2 | ! Example program of standard input and output streams. 3 | ! Listing 6.6 in the book. 4 | use iso_fortran_env, only: stdin => input_unit, & 5 | stdout => output_unit, & 6 | stderr => error_unit 7 | implicit none 8 | character(len=1000) :: text 9 | read(stdin, '(a)') text 10 | write(stdout, '(a)') trim(text) 11 | write(stderr, '(a)') 'This is an error message' 12 | end program standard_streams 13 | 14 | -------------------------------------------------------------------------------- /src/ch06/write_pi_to_text_and_binary.f90: -------------------------------------------------------------------------------- 1 | program write_pi 2 | ! Writing number pi to a text and a binary file. 3 | implicit none 4 | integer :: fileunit, record_length 5 | real, parameter :: pi = 4 * atan(1.) 6 | 7 | open(newunit=fileunit, file='pi.txt') 8 | write(fileunit, *) pi 9 | close(fileunit) 10 | 11 | record_length = storage_size(pi) / 8 12 | open(newunit=fileunit, file='pi.dat', access='direct', recl=record_length) 13 | write(fileunit, rec=1) pi 14 | close(fileunit) 15 | 16 | end program write_pi 17 | -------------------------------------------------------------------------------- /src/ch07/Makefile: -------------------------------------------------------------------------------- 1 | FC = caf 2 | 3 | PROGRAMS = hello_images hello_images_ordered coarrays 4 | 5 | .PHONY: all clean 6 | 7 | all: ${PROGRAMS} 8 | 9 | %: %.f90 10 | $(FC) $< -o $@ 11 | 12 | clean: 13 | $(RM) ${PROGRAMS} 14 | -------------------------------------------------------------------------------- /src/ch07/coarrays.f90: -------------------------------------------------------------------------------- 1 | program coarrays 2 | 3 | implicit none 4 | 5 | integer :: a[*] 6 | 7 | if (num_images() /= 2) & 8 | error stop 'Error: This program must be run on 2 images' 9 | 10 | a = 0 11 | 12 | if (this_image() == 1) then 13 | a = 1 14 | print *, 'Image ', this_image(), ' has value ', a 15 | print *, 'Image ', this_image(), ' sending new value to image 2' 16 | a[2] = 2 * a 17 | end if 18 | 19 | sync all 20 | 21 | if (this_image() == 2) then 22 | print *, 'Image ', this_image(), ' has value ', a 23 | print *, 'Image ', this_image(), ' sending new value to image 1' 24 | a[1] = 2 * a 25 | end if 26 | 27 | sync all 28 | 29 | if (this_image() == 2) & 30 | print *, 'Image ', this_image(), ' sees that image 1 now has value ', a[1] 31 | 32 | end program coarrays 33 | -------------------------------------------------------------------------------- /src/ch07/hello_images.f90: -------------------------------------------------------------------------------- 1 | program hello_images 2 | ! Program that prints the current image 3 | ! and the total number of images. 4 | print *, 'Hello from image', this_image(), 'of', num_images() 5 | end program hello_images 6 | -------------------------------------------------------------------------------- /src/ch07/hello_images_ordered.f90: -------------------------------------------------------------------------------- 1 | program hello_images_ordered 2 | ! Synchronizing parallel images to print in order. 3 | implicit none 4 | integer :: n 5 | do n = 1, num_images() 6 | if (this_image() == n) & 7 | print *, 'Hello from image', this_image(), 'of', num_images() 8 | sync all 9 | end do 10 | end program hello_images_ordered 11 | -------------------------------------------------------------------------------- /src/ch08/Makefile: -------------------------------------------------------------------------------- 1 | FC = gfortran 2 | 3 | PROGRAMS = hello_derived_types \ 4 | banking_app_example \ 5 | derived_type_constructor \ 6 | derived_type_init \ 7 | hello_derived_types_elemental 8 | 9 | .PHONY: all clean 10 | 11 | all: ${PROGRAMS} 12 | 13 | %: %.f90 14 | $(FC) $< -o $@ 15 | 16 | clean: 17 | $(RM) *.o *.mod ${PROGRAMS} 18 | -------------------------------------------------------------------------------- /src/ch08/banking_app_example.f90: -------------------------------------------------------------------------------- 1 | module mod_banking 2 | 3 | implicit none 4 | 5 | type :: datetime 6 | integer :: year, month, day, hour, minute, second 7 | end type datetime 8 | 9 | type :: Transaction 10 | character(:), allocatable :: name 11 | integer :: id, status 12 | type(datetime) :: time_created, time_processed 13 | real :: amount 14 | end type Transaction 15 | 16 | type :: Account 17 | character(:), allocatable :: name 18 | integer :: id, status 19 | type(datetime) :: time_opened, time_closed 20 | type(Transaction), allocatable :: transactions(:) 21 | end type Account 22 | 23 | type :: Customer 24 | character(:), allocatable :: name 25 | integer :: id, status 26 | type(datetime) :: time_created 27 | type(Account), allocatable :: accounts(:) 28 | end type Customer 29 | 30 | end module mod_banking 31 | 32 | program banking_app_example 33 | use mod_banking 34 | implicit none 35 | type(Customer) :: cust 36 | type(Account), allocatable :: accounts(:) 37 | allocate(accounts(0)) 38 | cust = Customer('Jill Jones', 1, 0, datetime(2018, 3, 26, 15, 21, 55), accounts) 39 | print *, 'Customer ' // cust % name // ' joined on ', cust % time_created 40 | end program banking_app_example 41 | -------------------------------------------------------------------------------- /src/ch08/derived_type_constructor.f90: -------------------------------------------------------------------------------- 1 | module mod_person 2 | 3 | implicit none 4 | 5 | type :: Person 6 | character(len=20) :: name 7 | integer :: age 8 | character(len=20) :: occupation 9 | character(len=20) :: greeting_message 10 | end type Person 11 | 12 | interface Person 13 | module procedure :: person_constructor 14 | end interface Person 15 | 16 | contains 17 | 18 | pure type(Person) function person_constructor(name, age, occupation) result(res) 19 | character(len=*), intent(in) :: name 20 | integer, intent(in) :: age 21 | character(len=*), intent(in) :: occupation 22 | res % name = name 23 | res % age = age 24 | res % occupation = occupation 25 | if (occupation == 'Pirate') then 26 | res % greeting_message = 'Ahoy, matey!' 27 | else 28 | res % greeting_message = 'Hi, there.' 29 | end if 30 | end function person_constructor 31 | 32 | end module mod_person 33 | 34 | program derived_type_constructor 35 | use mod_person, only: Person 36 | implicit none 37 | type(Person) :: some_person 38 | some_person = Person('Bob', 32, 'Engineer') 39 | print *, trim(some_person % name) // & 40 | ' says ' // trim(some_person % greeting_message) 41 | some_person = Person('Davey', 44, 'Pirate') 42 | print *, trim(some_person % name) // & 43 | ' says ' // trim(some_person % greeting_message) 44 | end program derived_type_constructor 45 | -------------------------------------------------------------------------------- /src/ch08/derived_type_init.f90: -------------------------------------------------------------------------------- 1 | module mod_person 2 | type :: Person 3 | character(len=20) :: name 4 | integer :: age 5 | character(len=20) :: occupation 6 | end type Person 7 | end module mod_person 8 | 9 | program hello_derived_types 10 | use mod_person, only: Person 11 | implicit none 12 | type(Person) :: some_person 13 | some_person = Person('Bob', 32, 'Engineer') 14 | print *, 'Hi, I am ' // trim(some_person % name) // ', a ', & 15 | some_person % age, 'year old ' // some_person % occupation 16 | end program hello_derived_types 17 | -------------------------------------------------------------------------------- /src/ch08/hello_derived_types.f90: -------------------------------------------------------------------------------- 1 | ! A "hello world" variant using derived types. 2 | ! Listing 8.2 in the book. 3 | module mod_person 4 | type :: Person 5 | character(len=10) :: name 6 | contains 7 | procedure, pass(self) :: greet 8 | end type Person 9 | contains 10 | subroutine greet(self) 11 | class(Person), intent(in) :: self 12 | print *, 'Hello, my name is ' // trim(self % name) // '!' 13 | end subroutine greet 14 | end module mod_person 15 | 16 | program hello_derived_types 17 | use mod_person, only: Person 18 | implicit none 19 | type(Person) :: some_person = Person('Jill') 20 | call some_person % greet() 21 | end program hello_derived_types 22 | -------------------------------------------------------------------------------- /src/ch08/hello_derived_types_elemental.f90: -------------------------------------------------------------------------------- 1 | module mod_person 2 | type :: Person 3 | character(len=10) :: name 4 | contains 5 | procedure, pass(self) :: greet 6 | end type Person 7 | contains 8 | impure elemental subroutine greet(self) 9 | class(Person), intent(in) :: self 10 | print *, 'Hello, my name is ' // trim(self % name) // '!' 11 | end subroutine greet 12 | end module mod_person 13 | 14 | program hello_derived_types 15 | use mod_person, only: Person 16 | implicit none 17 | type(Person) :: people(3) = [Person('Jill'), Person('James'), Person('Allison')] 18 | call people % greet() 19 | end program hello_derived_types 20 | -------------------------------------------------------------------------------- /src/ch09/Makefile: -------------------------------------------------------------------------------- 1 | FC = gfortran 2 | 3 | PROGRAMS = average_generic strcat 4 | 5 | .PHONY: all clean 6 | 7 | all: ${PROGRAMS} 8 | 9 | %: %.f90 10 | $(FC) $< -o $@ 11 | 12 | clean: 13 | $(RM) *.o *.mod ${PROGRAMS} 14 | -------------------------------------------------------------------------------- /src/ch09/average_generic.f90: -------------------------------------------------------------------------------- 1 | ! Implementing a generic function that works 2 | ! on built-in and derived types. 3 | ! Listing 9.19 - 9.21 in the book. 4 | module mod_field 5 | 6 | implicit none 7 | 8 | private 9 | public :: Field 10 | 11 | type :: Field 12 | real, allocatable :: data(:) 13 | end type Field 14 | 15 | end module mod_field 16 | 17 | module mod_average 18 | 19 | use mod_field, only: Field 20 | 21 | implicit none 22 | 23 | private 24 | public :: average 25 | 26 | interface average 27 | module procedure :: average_int 28 | module procedure :: average_real 29 | module procedure :: average_logical 30 | module procedure :: average_field 31 | end interface average 32 | 33 | contains 34 | 35 | pure real function average_int(x) result(res) 36 | integer, intent(in) :: x(:) 37 | res = real(sum(x), kind=kind(res)) / size(x) 38 | end function average_int 39 | 40 | pure real function average_real(x) result(res) 41 | real, intent(in) :: x(:) 42 | res = sum(x) / size(x) 43 | end function average_real 44 | 45 | pure real function average_logical(x) result(res) 46 | logical, intent(in) :: x(:) 47 | res = real(count(x), kind=kind(res)) / size(x) 48 | end function average_logical 49 | 50 | pure real function average_field(f) result(res) 51 | class(Field), intent(in) :: f 52 | res = average(f % data) 53 | end function average_field 54 | 55 | end module mod_average 56 | 57 | 58 | program test_average 59 | 60 | use mod_average, only: average 61 | use mod_field, only: field 62 | 63 | type(Field) :: f 64 | 65 | print *, average([1, 6, 4]) 66 | print *, average([1., 6., 4.]) 67 | print *, average([.true., .true., .false.]) 68 | 69 | f % data = [1., 6., 4.] 70 | print *, average(f) 71 | 72 | end program test_average 73 | -------------------------------------------------------------------------------- /src/ch09/average_incompatible.f90: -------------------------------------------------------------------------------- 1 | ! Example of passing an argument of incompatible type to a function. 2 | ! Listing 9.3 in the book. 3 | module mod_average 4 | 5 | implicit none 6 | 7 | private 8 | public :: average 9 | 10 | contains 11 | 12 | pure real function average(x) result(res) 13 | real, intent(in) :: x(:) 14 | res = sum(x) / size(x) 15 | end function average 16 | 17 | end module mod_average 18 | 19 | 20 | program test_average 21 | use mod_average, only: average 22 | print *, average([1, 6, 4]) 23 | end program test_average 24 | -------------------------------------------------------------------------------- /src/ch09/strcat.f90: -------------------------------------------------------------------------------- 1 | ! Implementing + operator for strings. 2 | ! Listing 9.20 in the book. 3 | module mod_strings 4 | 5 | implicit none 6 | 7 | private 8 | public :: operator(+) 9 | 10 | interface operator(+) 11 | module procedure :: strcat 12 | end interface 13 | 14 | contains 15 | 16 | function strcat(s1, s2) result(res) 17 | character(len=*), intent(in) :: s1, s2 18 | character(len=:), allocatable :: res 19 | res = s1 // s2 20 | end function strcat 21 | 22 | end module mod_strings 23 | 24 | program strcat 25 | use mod_strings, only: operator(+) 26 | print *, 'Hello' + ' world' 27 | end program strcat 28 | -------------------------------------------------------------------------------- /src/ch10/average_generic.f90: -------------------------------------------------------------------------------- 1 | module mod_field 2 | 3 | implicit none 4 | 5 | private 6 | public :: Field 7 | 8 | type :: Field 9 | real, allocatable :: data(:) 10 | end type Field 11 | 12 | end module mod_field 13 | 14 | module mod_average 15 | 16 | use mod_field, only: Field 17 | 18 | implicit none 19 | 20 | private 21 | public :: average 22 | 23 | interface average 24 | module procedure :: average_int 25 | module procedure :: average_real 26 | module procedure :: average_logical 27 | module procedure :: average_field 28 | end interface average 29 | 30 | contains 31 | 32 | pure real function average_int(x) result(res) 33 | integer, intent(in) :: x(:) 34 | res = real(sum(x), kind=kind(res)) / size(x) 35 | end function average_int 36 | 37 | pure real function average_real(x) result(res) 38 | real, intent(in) :: x(:) 39 | res = sum(x) / size(x) 40 | end function average_real 41 | 42 | pure real function average_logical(x) result(res) 43 | logical, intent(in) :: x(:) 44 | res = real(count(x), kind=kind(res)) / size(x) 45 | end function average_logical 46 | 47 | pure real function average_field(f) result(res) 48 | class(Field), intent(in) :: f 49 | res = average(f % data) 50 | end function average_field 51 | 52 | end module mod_average 53 | 54 | 55 | program test_average 56 | 57 | use mod_average, only: average 58 | use mod_field, only: field 59 | 60 | type(Field) :: f 61 | 62 | print *, average([1, 6, 4]) 63 | print *, average([1., 6., 4.]) 64 | print *, average([.true., .true., .false.]) 65 | 66 | f % data = [1., 6., 4.] 67 | print *, average(f) 68 | 69 | end program test_average 70 | -------------------------------------------------------------------------------- /src/ch10/mod_average_incompatible.f90: -------------------------------------------------------------------------------- 1 | module mod_average 2 | 3 | implicit none 4 | 5 | private 6 | public :: average 7 | 8 | contains 9 | 10 | pure real function average(x) result(res) 11 | real, intent(in) :: x(:) 12 | res = sum(x) / size(x) 13 | end function average 14 | 15 | end module mod_average 16 | 17 | 18 | program test_average 19 | use mod_average, only: average 20 | print *, average([1, 6, 4]) 21 | end program test_average 22 | -------------------------------------------------------------------------------- /src/ch10/strcat.f90: -------------------------------------------------------------------------------- 1 | module mod_strings 2 | 3 | implicit none 4 | 5 | private 6 | public :: operator(+) 7 | 8 | interface operator(+) 9 | module procedure :: strcat 10 | end interface 11 | 12 | contains 13 | 14 | function strcat(s1, s2) result(res) 15 | character(len=*), intent(in) :: s1, s2 16 | character(len=:), allocatable :: res 17 | res = s1 // s2 18 | end function strcat 19 | 20 | end module mod_strings 21 | 22 | program strcat 23 | use mod_strings, only: operator(+) 24 | print *, 'Hello' + ' world' 25 | end program strcat 26 | --------------------------------------------------------------------------------