├── .gitattributes ├── .gitignore ├── code-book ├── prog01 │ ├── prog01_01 │ │ └── prog01_01.f90 │ ├── prog01_15 │ │ ├── prog01_15.f90 │ │ └── prog01_15m.f90 │ ├── prog01_02 │ │ └── prog01_02.f90 │ ├── prog01_03 │ │ └── prog01_03.f90 │ ├── prog01_06 │ │ └── prog01_06.f90 │ ├── prog01_05 │ │ └── prog01_05.f90 │ ├── prog01_04 │ │ └── prog01_04.f90 │ ├── prog01_10 │ │ └── prog01_10.f90 │ ├── prog01_07 │ │ └── prog01_07.f90 │ ├── prog01_16 │ │ ├── prog01_16.f90 │ │ └── prog01_16m.f90 │ ├── prog01_13 │ │ └── prog01_13.f90 │ ├── prog01_08 │ │ └── prog01_08.f90 │ ├── prog01_09 │ │ └── prog01_09.f90 │ ├── prog01_11 │ │ └── prog01_11.f90 │ ├── prog01_12 │ │ └── prog01_12.f90 │ ├── prog01_14 │ │ └── prog01_14.f90 │ ├── prog01_17 │ │ └── prog01_17.f90 │ └── prog01_18 │ │ └── prog01_18.f90 ├── prog02 │ ├── prog02_11 │ │ ├── prog02_11m.f90 │ │ └── prog02_11.f90 │ ├── prog02_14 │ │ ├── prog02_14m.f90 │ │ └── prog02_14.f90 │ ├── prog02_13 │ │ └── prog02_13.f90 │ ├── prog02_08 │ │ ├── prog02_08m.f90 │ │ └── prog02_08.f90 │ ├── prog02_03 │ │ └── prog02_03.f90 │ ├── prog02_12 │ │ └── prog02_12.f90 │ ├── prog02_02 │ │ └── prog02_02.f90 │ ├── prog02_20 │ │ └── prog02_20.f90 │ ├── prog02_07 │ │ └── prog02_07.f90 │ ├── prog02_09 │ │ └── prog02_09.f90 │ ├── prog02_06 │ │ └── prog02_06.f90 │ ├── prog02_17 │ │ └── prog02_17.f90 │ ├── prog02_04 │ │ └── prog02_04.f90 │ ├── prog02_10 │ │ └── prog02_10.f90 │ ├── prog02_05 │ │ └── prog02_05.f90 │ ├── prog02_18 │ │ └── prog02_18.f90 │ ├── prog02_01 │ │ └── prog02_01.f90 │ └── prog02_16 │ │ └── prog02_16.f90 ├── prog03 │ ├── prog03_01 │ │ ├── prog03_01m.f90 │ │ └── prog03_01.f90 │ ├── prog03_02 │ │ ├── prog03_02m.f90 │ │ └── prog03_02.f90 │ ├── prog03_03 │ │ ├── prog03_03m.f90 │ │ └── prog03_03.f90 │ ├── prog03_04 │ │ └── prog03_04m.f90 │ └── prog03_06 │ │ └── prog03_06m.f90 ├── prog08 │ ├── prog08_01 │ │ └── prog08_01.f90 │ ├── prog08_07 │ │ └── prog08_07m.f90 │ ├── prog08_03 │ │ └── prog08_03m.f90 │ ├── prog08_04 │ │ └── prog08_04m.f90 │ ├── prog08_06 │ │ └── prog08_06m.f90 │ ├── prog08_02 │ │ └── prog08_02.f90 │ └── prog08_05 │ │ └── prog08_05m.f90 ├── prog05 │ ├── prog05_01 │ │ ├── prog05_01.f90 │ │ └── prog05_01m.f90 │ ├── prog05_02 │ │ └── prog05_02.f90 │ ├── prog05_03 │ │ └── prog05_03.f90 │ └── prog05_05 │ │ └── prog05_05.f90 ├── prog04 │ └── prog04_02 │ │ └── prog04_02m.f90 ├── prog06 │ ├── prog06_01 │ │ └── prog06_01.f90 │ └── prog06_02 │ │ └── prog06_02.f90 └── prog09 │ ├── prog09_01 │ └── prog09_01m.f90 │ ├── prog09_02 │ └── prog09_02m.f90 │ └── prog09_04 │ └── prog09_04m.f90 ├── installation ├── docker │ ├── docker_base │ │ ├── makefile │ │ ├── Dockerfile │ │ └── install_fortran.sh │ └── docker_vnc │ │ ├── makefile │ │ └── Dockerfile ├── mac │ ├── uninstall_fortran.command │ └── update_toolbox.command └── ubuntu │ ├── uninstall_fortran.sh │ └── update_toolbox.sh ├── code-solution ├── sol_prog01 │ ├── sol_prog01_04 │ │ └── sol_prog01_04.f90 │ ├── sol_prog01_02 │ │ └── sol_prog01_02.f90 │ ├── sol_prog01_10 │ │ ├── sol_prog01_10.f90 │ │ └── sol_prog01_10m.f90 │ ├── sol_prog01_09 │ │ ├── sol_prog01_09m.f90 │ │ └── sol_prog01_09.f90 │ ├── sol_prog01_07 │ │ └── sol_prog01_07.f90 │ ├── sol_prog01_01 │ │ └── sol_prog01_01.f90 │ ├── sol_prog01_03 │ │ └── sol_prog01_03.f90 │ ├── sol_prog01_05 │ │ └── sol_prog01_05.f90 │ ├── sol_prog01_08 │ │ └── sol_prog01_08.f90 │ └── sol_prog01_06 │ │ └── sol_prog01_06.f90 ├── sol_prog04 │ ├── sol_prog04_02 │ │ ├── sol_prog04_02.f90 │ │ └── sol_prog04_02m.f90 │ ├── sol_prog04_05 │ │ └── sol_prog04_05.f90 │ ├── sol_prog04_01 │ │ └── sol_prog04_01m.f90 │ └── sol_prog04_12 │ │ ├── sol_prog04_12m.f90 │ │ └── sol_prog04_12.f90 ├── sol_prog09 │ ├── sol_prog09_06 │ │ └── sol_prog09_06m.f90 │ └── sol_prog09_03 │ │ └── sol_prog09_03m.f90 ├── sol_prog05 │ ├── sol_prog05_01 │ │ ├── sol_prog05_01.f90 │ │ └── sol_prog05_01m.f90 │ ├── sol_prog05_02 │ │ └── sol_prog05_02.f90 │ └── sol_prog05_03 │ │ └── sol_prog05_03.f90 ├── sol_prog02 │ ├── sol_prog02_06 │ │ └── sol_prog02_06m.f90 │ ├── sol_prog02_04 │ │ ├── sol_prog02_04m.f90 │ │ └── sol_prog02_04.f90 │ ├── sol_prog02_07 │ │ ├── sol_prog02_07m.f90 │ │ └── sol_prog02_07.f90 │ ├── sol_prog02_02 │ │ ├── sol_prog02_02m.f90 │ │ └── sol_prog02_02.f90 │ ├── sol_prog02_09 │ │ └── sol_prog02_09m.f90 │ ├── sol_prog02_03 │ │ ├── sol_prog02_03.f90 │ │ └── sol_prog02_03m.f90 │ ├── sol_prog02_10 │ │ └── sol_prog02_10m.f90 │ ├── sol_prog02_01 │ │ └── sol_prog02_01.f90 │ └── sol_prog02_11 │ │ └── sol_prog02_11.f90 ├── sol_prog08 │ ├── sol_prog08_06 │ │ └── sol_prog08_06m.f90 │ ├── sol_prog08_09 │ │ └── sol_prog08_09m.f90 │ ├── sol_prog08_05 │ │ └── sol_prog08_05m.f90 │ ├── sol_prog08_08 │ │ └── sol_prog08_08m.f90 │ ├── sol_prog08_04 │ │ └── sol_prog08_04m.f90 │ └── sol_prog08_07 │ │ └── sol_prog08_07m.f90 ├── sol_prog06 │ ├── sol_prog06_03 │ │ └── sol_prog06_03.f90 │ ├── sol_prog06_05 │ │ └── sol_prog06_05.f90 │ ├── sol_prog06_04 │ │ └── sol_prog06_04.f90 │ ├── sol_prog06_06 │ │ └── sol_prog06_06.f90 │ ├── sol_prog06_02 │ │ └── sol_prog06_02.f90 │ └── sol_prog06_01 │ │ └── sol_prog06_01.f90 └── sol_prog03 │ ├── sol_prog03_02 │ ├── sol_prog03_02m.f90 │ └── sol_prog03_02.f90 │ ├── sol_prog03_04 │ ├── sol_prog03_04.f90 │ └── sol_prog03_04m.f90 │ ├── sol_prog03_03 │ ├── sol_prog03_03m.f90 │ └── sol_prog03_03.f90 │ └── sol_prog03_05 │ └── sol_prog03_05.f90 └── README.md /.gitattributes: -------------------------------------------------------------------------------- 1 | # Batch files should have cp1252 encoding # 2 | ########################################### 3 | *.bat encoding=cp1252 -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Mac Structure Files # 2 | ####################### 3 | .DS_Store 4 | 5 | # Fortran Compile Files # 6 | ######################### 7 | *.mod 8 | *.o 9 | *.obj 10 | *.exe 11 | build/ 12 | 13 | # VSCode Configuration # 14 | ######################### 15 | .vscode -------------------------------------------------------------------------------- /code-book/prog01/prog01_01/prog01_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM HelloWorld 3 | ! 4 | ! ## Write "Hello World" to the console 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program HelloWorld 14 | 15 | write(*,*)'Hello World' 16 | 17 | end program 18 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_15/prog01_15.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Sphere 3 | ! 4 | ! ## A program that uses a module 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog01_15m.f90" 14 | 15 | program Sphere 16 | 17 | ! import variables and subroutines from module Volume 18 | use Volume 19 | 20 | implicit none 21 | 22 | write(*,'(f12.4)')vol(1d0) 23 | 24 | end program 25 | -------------------------------------------------------------------------------- /installation/docker/docker_base/makefile: -------------------------------------------------------------------------------- 1 | # A MAKE FILE TO COPY THE RIGHT CODES AND CREATE THE DOCKER IMAGE 2 | # 3 | # This code is published under the GNU General Public License v3 4 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 5 | # 6 | # Author: Fabian Kindermann (contact@ce-fortran.com) 7 | 8 | name = "fabiankindermann/ce-fortran" 9 | 10 | # CLEAN UP THE WORKSPACE 11 | .PHONY: clean 12 | clean : 13 | rm -rf code-book 14 | rm -rf code-solution 15 | rm -rf toolbox.f90 16 | 17 | .PHONY: build 18 | build : 19 | cp -R ../../../code-book . 20 | cp -R ../../../code-solution . 21 | cp ../../toolbox/toolbox.f90 . 22 | docker build -t $(name) . 23 | docker tag $(name) $(name):$(version) 24 | rm -rf code-book 25 | rm -rf code-solution 26 | rm -rf toolbox.f90 -------------------------------------------------------------------------------- /installation/docker/docker_vnc/makefile: -------------------------------------------------------------------------------- 1 | # A MAKE FILE TO COPY THE RIGHT CODES AND CREATE THE DOCKER IMAGE 2 | # 3 | # This code is published under the GNU General Public License v3 4 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 5 | # 6 | # Author: Fabian Kindermann (contact@ce-fortran.com) 7 | 8 | name = "fabiankindermann/ce-fortran-vnc" 9 | 10 | # CLEAN UP THE WORKSPACE 11 | .PHONY: clean 12 | clean : 13 | rm -rf code-book 14 | rm -rf code-solution 15 | rm -rf toolbox.f90 16 | 17 | .PHONY: build 18 | build : 19 | cp -R ../../../code-book . 20 | cp -R ../../../code-solution . 21 | cp ../../toolbox/toolbox.f90 . 22 | docker build -t $(name) . 23 | docker tag $(name) $(name):$(version) 24 | rm -rf code-book 25 | rm -rf code-solution 26 | rm -rf toolbox.f90 -------------------------------------------------------------------------------- /code-book/prog01/prog01_02/prog01_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Hello 3 | ! 4 | ! ## Read and write numbers from/to the console 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Hello 14 | 15 | ! declaration of variables 16 | implicit none 17 | character(len=50) :: input 18 | 19 | ! executable code 20 | write(*,*)'Please type your name:' 21 | read(*,*)input 22 | write(*,*)'Hello ',input 23 | 24 | end program 25 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_03/prog01_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM VarDec 3 | ! 4 | ! ## Shows how to declare variables 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program VarDec 14 | 15 | ! declaration of variables 16 | implicit none 17 | logical :: logic 18 | integer :: a, b 19 | real*8 :: x, y1 20 | character :: one_char 21 | character(len=20) :: long_char 22 | 23 | real*8, parameter :: pi = 3.14d0 24 | integer, parameter :: n = 56 25 | 26 | end program 27 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_06/prog01_06.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Arithmetics 3 | ! 4 | ! ## Basic mathematical calculations 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Arithmetics 14 | 15 | ! declaration of variables 16 | implicit none 17 | real*8 :: a, b, c, d 18 | 19 | ! executable code 20 | a = 6d0 21 | b = 2.5d0 22 | c = exp(b) + a**2*sqrt(b) 23 | d = max(a,b)*sign(b, a)/mod(9d0,5d0) + abs(c) 24 | 25 | write(*, '(4f10.4)')a,b,c,d 26 | 27 | end program 28 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_04/sol_prog01_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Logicals 3 | ! 4 | ! ## Evaluate logical expression 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Logicals 14 | 15 | implicit none 16 | 17 | ! declare variables 18 | integer :: x, y, z 19 | 20 | ! assign values 21 | x = 4 22 | y = 6 23 | z = 8 24 | 25 | ! print output 26 | write(*,*)(x >= 3 .and. y <= 4 .and. z == 5 .or. x <= y .and. y < z) 27 | 28 | end program 29 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_05/prog01_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Formatter 3 | ! 4 | ! ## Write numbers with formatters 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Formatter 14 | 15 | ! declaration of variables 16 | implicit none 17 | integer :: a 18 | real*8 :: x 19 | 20 | ! executable code 21 | write(*,*)'Type an integer number:' 22 | read(*,*)a 23 | 24 | write(*,*)'Type a real number:' 25 | read(*,*)x 26 | 27 | write(*,'(i3, 2x, f10.6)')a, x 28 | 29 | end program 30 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_04/prog01_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM ReadWrite 3 | ! 4 | ! ## Read and write number of different types from console 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program ReadWrite 14 | 15 | ! declaration of variables 16 | implicit none 17 | integer :: a 18 | real*8 :: x 19 | 20 | ! executable code 21 | write(*,*)'Type an integer number:' 22 | read(*,*)a 23 | 24 | write(*,*)'Type a real number:' 25 | read(*,*)x 26 | 27 | write(*,*)a, x 28 | 29 | end program 30 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_11/prog02_11m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: p(2) = (/1d0, 2d0/) 15 | real*8, parameter :: W = 1d0 16 | 17 | contains 18 | 19 | 20 | ! the utility function 21 | function utility(x) 22 | 23 | implicit none 24 | real*8, intent(in) :: x 25 | real*8 :: utility 26 | 27 | utility = -(((W-p(2)*x)/p(1))**0.4d0+(1d0+x)**0.5d0) 28 | 29 | end function 30 | 31 | end module globals 32 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_02/sol_prog01_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM RealAndStar8 3 | ! 4 | ! ## Compare type real with real*8 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program RealAndStar8 14 | 15 | implicit none 16 | 17 | ! declaration of variables 18 | real :: sum1 19 | real*8 :: sum2 20 | 21 | ! calculation of the sums 22 | sum1 = 55555553 + 10000001 23 | sum2 = 55555553 + 10000001 24 | 25 | ! print output 26 | write(*,'(a, f15.2)')'Using real =', sum1 27 | write(*,'(a, f15.2)')'Using real*8 =', sum2 28 | 29 | end program 30 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_10/prog01_10.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Arrays 3 | ! 4 | ! ## Use do-loops to fill up arrays with values 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Arrays 14 | 15 | implicit none 16 | real*8 :: x(0:10), y(0:10) 17 | integer :: j 18 | 19 | ! initialize x and calculate y 20 | do j = 0, 10 21 | x(j) = 1d0/10d0*dble(j) 22 | y(j) = exp(x(j)) 23 | enddo 24 | 25 | ! output table of values 26 | write(*,'(a)')' X Y' 27 | do j = 0, 10 28 | write(*,'(2f10.3)')x(j), y(j) 29 | enddo 30 | 31 | end program 32 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_07/prog01_07.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM IfStatements 3 | ! 4 | ! ## How to use if statements to control program flow 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program IfStatements 14 | 15 | implicit none 16 | integer :: a 17 | 18 | ! initialize a 19 | a = 1 20 | 21 | ! check for the size of a 22 | if(a < 1)then 23 | write(*,'(a)')'condition 1 is true' 24 | elseif(a < 2)then 25 | write(*,'(a)')'condition 2 is true' 26 | elseif(a < 3)then 27 | write(*,'(a)')'condition 3 is true' 28 | else 29 | write(*,'(a)')'no condition is true' 30 | endif 31 | 32 | end program 33 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_15/prog01_15m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE Volume 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module Volume 12 | 13 | implicit none 14 | 15 | ! module parameter 16 | real*8, parameter :: pi = 3.14159265358d0 17 | 18 | ! separates variable declarations from subroutine and functions 19 | contains 20 | 21 | 22 | ! for calculating volume of a sphere 23 | function vol(r) 24 | 25 | implicit none 26 | 27 | ! input and output variables 28 | real*8, intent(in) :: r 29 | real*8 :: vol 30 | 31 | ! calculation 32 | vol = 4d0/3d0*r**3*pi 33 | 34 | end function 35 | 36 | end module 37 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_14/prog02_14m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: mu = 1d0, sig2 = 0.1d0, minp = 1d0 15 | integer, parameter :: n = 10 16 | real*8 :: y(0:n), w(0:n) 17 | 18 | contains 19 | 20 | 21 | function market(A) 22 | 23 | implicit none 24 | real*8, intent(in) :: A 25 | real*8 :: market 26 | real*8 :: Ep 27 | 28 | ! calculate expected price 29 | Ep = sum(w*max(3d0-2d0*A*y, minp)) 30 | 31 | ! get equilibrium equation 32 | market = A - (0.5d0+0.5d0*Ep) 33 | 34 | end function 35 | 36 | end module globals 37 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_10/sol_prog01_10.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM SubFunc 3 | ! 4 | ! ## Calculate utilty for different values of consumption within subroutine 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog01_10m.f90" 14 | 15 | program SubFunc 16 | 17 | use globals 18 | 19 | implicit none 20 | 21 | ! declaration of variables 22 | integer :: i 23 | real*8 :: u(n), a, b 24 | 25 | ! initialize values for a and b 26 | a = 0.5d0 27 | b = 5d0 28 | 29 | ! call subroutine to compute utilities 30 | call utility_int(a, b, u) 31 | 32 | ! print output 33 | write(*,'(f12.5)') (u(i), i = 1, n) 34 | 35 | end program SubFunc 36 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_13/prog02_13.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM GaussLegendre 3 | ! 4 | ! ## Numerical integration with Gauss-Legendre quadrature 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program GaussLegendre 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer, parameter :: n = 10 19 | real*8, parameter :: a = 0d0, b = 2d0 20 | real*8 :: x(0:n), w(0:n), f(0:n) 21 | 22 | ! calculate nodes and weights 23 | call legendre(0d0, 2d0, x, w) 24 | 25 | ! calculate function values at nodes 26 | f = cos(x) 27 | 28 | ! Output numerical and analytical solution 29 | write(*,'(a,f10.6)')' Numerical: ',sum(w*f, 1) 30 | write(*,'(a,f10.6)')' Analytical: ',sin(2d0)-sin(0d0) 31 | 32 | end program 33 | -------------------------------------------------------------------------------- /installation/docker/docker_vnc/Dockerfile: -------------------------------------------------------------------------------- 1 | # A DOCKER FILE TO BUNDLE THE CE-FORTRAN ENVIRONMENT INTO A DOCKER CONTAINER WITH GUI 2 | # 3 | # Special thanks to Lars Vilhuber for starting this project. 4 | # 5 | # This code is published under the GNU General Public License v3 6 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 7 | # 8 | # Author: Fabian Kindermann (contact@ce-fortran.com) 9 | 10 | FROM dorowu/ubuntu-desktop-lxde-vnc 11 | 12 | WORKDIR /root 13 | 14 | # COPY SOURCEy FILES INTO BASIC DIRECTORY 15 | COPY install_fortran.sh . 16 | 17 | # COPY CE-FORTRAN PROGRAMS 18 | COPY ./code-book ./code-book 19 | 20 | # COPY CE-FORTRAN SOLUTIONS 21 | COPY ./code-solution ./code-solution 22 | 23 | # COPY TOOLBOX 24 | COPY toolbox.f90 . 25 | 26 | # ADD FONT FILE 27 | COPY ./localfonts.conf /etc/fonts/local.conf 28 | 29 | # INSTALL FORTRAN DEVELOPMENT ENVIRONMENT 30 | RUN chmod a+rx install_fortran.sh \ 31 | && DEBIAN_FRONTEND="noninteractive" TZ="Europe/Berlin" ./install_fortran.sh \ 32 | && rm -r install_fortran.sh && rm -rf /var/lib/apt/lists/* 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_08/prog02_08m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | ! variable declaration 14 | implicit none 15 | real*8 :: eta = 1.6d0 16 | real*8 :: c(2) = (/0.6d0, 0.8d0/) 17 | 18 | contains 19 | 20 | 21 | ! function that defines the oligopoly equations 22 | function cournot(q) 23 | 24 | implicit none 25 | real*8, intent(in) :: q(:) 26 | real*8 :: cournot(size(q, 1)),QQ 27 | integer :: i 28 | 29 | QQ = sum(q) 30 | do i = 1,size(q, 1) 31 | cournot(i) = QQ**(-1d0/eta)-1d0/eta*QQ**(-1d0/eta-1)*q(i)-c(i)*q(i) 32 | enddo 33 | 34 | end function cournot 35 | 36 | end module 37 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_16/prog01_16.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM CalcUtil 3 | ! 4 | ! ## Calculate utility of household for different values of c1 and c2 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog01_16m.f90" 14 | 15 | program CalcUtil 16 | 17 | use Globals 18 | use UtilFunc 19 | 20 | implicit none 21 | real*8 :: c1, c2, util 22 | integer :: j 23 | 24 | ! initialize parameters 25 | beta = 0.9d0 26 | eta = 2d0 27 | 28 | ! calculate utility for different consumption pairs 29 | ! between 0.3 and 0.7 30 | do j = 0, 20 31 | c1 = 0.3d0 + (0.7d0-0.3d0)/20*dble(j) 32 | c2 = 1d0-c1 33 | util = utility(c1, c2) 34 | write(*,'(3f10.4)')c1, c2, util 35 | enddo 36 | 37 | end program 38 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_11/prog02_11.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM brentmin 3 | ! 4 | ! ## Finding the minimum of a function with simple constraints 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog02_11m.f90" 14 | 15 | program brentmin 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x, f, a, b 22 | 23 | ! initial interval and function values 24 | a = 0d0 25 | b = (W-p(1)*0.01d0)/p(2) 26 | 27 | ! set starting point 28 | x = (a+b)/2d0 29 | 30 | ! call minimizing routine 31 | call fminsearch(x, f, a, b, utility) 32 | 33 | ! output 34 | write(*,'(/a,f12.7)')' x_1 = ',(W-p(2)*x)/p(1) 35 | write(*,'(a,f12.7)')' x_2 = ',x 36 | write(*,'(a,f12.7)')' u = ',-f 37 | 38 | end program 39 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_13/prog01_13.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Functions 3 | ! 4 | ! ## Store reusable code in functions with output argument 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Functions 14 | 15 | implicit none 16 | real*8 :: a, b, res 17 | 18 | a = 3d0 19 | b = 5d0 20 | 21 | ! call function 22 | res = addIt(a,b) 23 | 24 | ! output 25 | write(*,'(2(f8.2,a),f8.2)')a,' + ',b,' = ',res 26 | 27 | contains 28 | 29 | 30 | function addIt(a, b) 31 | 32 | implicit none 33 | 34 | ! input arguments 35 | real*8, intent(in) :: a, b 36 | 37 | ! function value 38 | real*8 :: addIt 39 | 40 | ! executable code 41 | addIt = a + b 42 | 43 | end function 44 | 45 | end program 46 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_01/prog03_01m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Lbar = 20d0 16 | real*8, parameter :: alpha = 0.3d0 17 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 18 | 19 | contains 20 | 21 | 22 | ! function to determine command optimum 23 | function utility(x) 24 | 25 | implicit none 26 | real*8, intent(in) :: x(:) 27 | real*8 :: utility 28 | 29 | ! utility function 30 | utility = -((x(2)**beta(1)*x(1)**(1d0-beta(1)))**alpha* & 31 | ((Lbar-x(2))**beta(2)*(Kbar-x(1))**(1d0-beta(2)))**(1-alpha)) 32 | 33 | end function 34 | 35 | end module 36 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_08/prog02_08.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM oligopoly 3 | ! 4 | ! ## Multi-dimensional rootfinding with the toolbox routine fzero 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog02_08m.f90" 14 | 15 | program oligopoly 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: q(2) 22 | logical :: check 23 | 24 | ! initialize q 25 | q = 0.1d0 26 | 27 | ! find root 28 | call fzero(q, cournot, check) 29 | 30 | if(check)stop 'Error: fzero did not converge' 31 | 32 | ! output 33 | write(*,'(/a)')' Output' 34 | write(*,'(a,f10.4)')'Firm 1: ',q(1) 35 | write(*,'(a,f10.4)')'Firm 2: ',q(2) 36 | write(*,'(/a,f10.4)')'Price : ',(q(1)+q(2))**(-1d0/1.6d0) 37 | 38 | end program 39 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_02/sol_prog04_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM ImpliedVolatility 3 | ! 4 | ! ## The implied volatility of an european option for a given price cE 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog04_02m.f90" 14 | 15 | program ImpliedVolatility 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: sigma 22 | logical :: check 23 | 24 | ! set up initial guess 25 | sigma = 0.5d0 26 | 27 | ! call subroutine fzero 28 | call fzero(sigma, DIFF, check) 29 | 30 | ! check for convergence 31 | if(check)stop 'Error: fzero did not converge' 32 | 33 | ! print output to the screen 34 | write(*,'(a,f10.1)')'Implied Volatility (in %): ', sigma*100 35 | 36 | end program 37 | -------------------------------------------------------------------------------- /code-solution/sol_prog09/sol_prog09_06/sol_prog09_06m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of transitory shock process values 16 | integer, parameter :: NS = 15 17 | 18 | ! risk process 19 | real*8, parameter :: sigma = 1d0 20 | real*8, parameter :: rho = 0.5d0 21 | 22 | ! numerical parameters 23 | real*8, parameter :: sig = 1d-6 24 | integer, parameter :: itermax = 100 25 | 26 | ! counter variables 27 | integer :: iter, is, is_p 28 | 29 | ! the risk process 30 | real*8 :: pi(NS, NS), eta(NS) 31 | 32 | ! distribution variables 33 | real*8 :: phi(NS), phi_new(NS), phi_cdf(NS) 34 | real*8 :: con_lev 35 | 36 | end module 37 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_08/prog01_08.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM DoLoops 3 | ! 4 | ! ## How to use do-loops to control program flows 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program DoLoops 14 | 15 | implicit none 16 | integer :: j 17 | 18 | ! perform a do-loop for j = 1 to 10 19 | do j = 1, 10 20 | write(*,'(i3)')j 21 | enddo 22 | 23 | ! write a blank line 24 | write(*,*) 25 | 26 | ! perform a do-loop for j = 10 to 1 27 | do j = 10, 1, -1 28 | write(*,'(i3)')j 29 | enddo 30 | 31 | ! write a blank line 32 | write(*,*) 33 | 34 | ! alternative do-loop 35 | j = 1 36 | do 37 | write(*,'(i3)')j 38 | j = j + 1 39 | 40 | ! exit the do-loop 41 | if(j > 10)exit 42 | enddo 43 | 44 | end program 45 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_03/prog02_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM inversion 3 | ! 4 | ! ## Invert a matrix using LU-decomposition 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program inversion 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer :: i, j 19 | real*8 :: A(3, 3), Ainv(3, 3), b(3) 20 | 21 | ! set up matrix and vector 22 | A(1, :) = (/ 2d0, 0d0, 1d0/) 23 | A(2, :) = (/ 0d0, 4d0, 1d0/) 24 | A(3, :) = (/ 1d0, 1d0, 2d0/) 25 | b = (/30d0, 40d0, 30d0/) 26 | 27 | ! invert A 28 | Ainv = lu_invert(A) 29 | 30 | ! calculate solution 31 | b = matmul(Ainv, b) 32 | 33 | ! output 34 | write(*,'(a,3f7.2/)')' x = ', (b(j),j=1,3) 35 | write(*,'(a,3f7.2/,2(8x,3f7.2/))') & 36 | ' A^-1 = ',((Ainv(i,j),j=1,3),i=1,3) 37 | 38 | end program 39 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_01/prog08_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM allinone 3 | ! 4 | ! ## The all-in-one solution to the cake eating problem 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program allinone 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! model parameters 20 | real*8, parameter :: gamma = 0.5d0 21 | real*8, parameter :: beta = 0.95d0 22 | real*8, parameter :: a0 = 100d0 23 | 24 | ! other variables 25 | integer, parameter :: TT = 200 26 | real*8 :: c_t(0:TT) 27 | integer :: it 28 | 29 | ! calculate the time path of consumption 30 | do it = 0, TT 31 | c_t(it) = beta**(dble(it)*gamma)*(1d0 - beta**gamma)*a0 32 | enddo 33 | 34 | call plot((/(dble(it),it=0,TT)/), c_t) 35 | call execplot(xlabel='Time t', ylabel='Consumption c_t') 36 | 37 | end program 38 | -------------------------------------------------------------------------------- /code-book/prog05/prog05_01/prog05_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM household1 3 | ! 4 | ! ## The life cycle model without uncertainty 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog05_01m.f90" 14 | 15 | program household1 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(2) 22 | real*8 :: fret, low(2), up(2) 23 | 24 | ! lower and upper border and initial guess 25 | low = (/0d0, 0d0/) 26 | up = (/w, R*w+w/) 27 | x = up/2d0 28 | 29 | ! minimization routine 30 | call fminsearch(x, fret, low, up, utility) 31 | 32 | ! output 33 | write(*,'(/a/)')' AGE CONS WAGE INC SAV' 34 | write(*,'(i4,4f7.2/)')1,c(1),w,w,a(2) 35 | write(*,'(i4,4f7.2/)')2,c(2),w,w+R*a(2),a(3) 36 | write(*,'(i4,4f7.2)')3,c(3),0d0,R*a(3),0d0 37 | 38 | end program 39 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_12/prog02_12.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM NewtonCotes 3 | ! 4 | ! ## Numerical integration with Newton-Cotes formulas 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program NewtonCotes 14 | 15 | implicit none 16 | integer, parameter :: n = 10 17 | real*8, parameter :: a = 0d0, b = 2d0 18 | real*8 :: h, x(0:n), w(0:n), f(0:n) 19 | integer :: i 20 | 21 | ! calculate quadrature nodes 22 | h = (b-a)/dble(n) 23 | x = (/(a + dble(i)*h, i=0,n)/) 24 | 25 | ! get weights 26 | w(0) = h/2d0 27 | w(n) = h/2d0 28 | w(1:n-1) = h 29 | 30 | ! calculate function values at nodes 31 | f = cos(x) 32 | 33 | ! Output numerical and analytical solution 34 | write(*,'(a,f10.6)')' Numerical: ',sum(w*f, 1) 35 | write(*,'(a,f10.6)')' Analytical: ',sin(2d0)-sin(0d0) 36 | 37 | end program 38 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_09/prog01_09.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM SummingUp 3 | ! 4 | ! ## Use do loops to sum up integer numbers successively 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program SummingUp 14 | 15 | implicit none 16 | integer :: i, j, sum 17 | 18 | ! read the variable 19 | write(*,'(a)')'Type an integer variable that is > 0' 20 | read(*,*)i 21 | 22 | ! check whether i > 0 23 | if(i > 0)then 24 | 25 | ! initialize sum at 0 26 | sum = 0 27 | 28 | ! do the summing up 29 | do j = 1, i 30 | sum = sum + j 31 | enddo 32 | 33 | ! write the result to the console 34 | write(*,'(a,i3,a,i10)')'The sum of 1 to ',i,' is ',sum 35 | 36 | else 37 | 38 | ! write the error message 39 | write(*,'(a)')'Error: i should be greater than 0' 40 | endif 41 | 42 | end program 43 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_16/prog01_16m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE Globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module Globals 12 | 13 | implicit none 14 | 15 | ! time preference 16 | real*8 :: beta 17 | 18 | ! risk aversion 19 | real*8 :: eta 20 | 21 | end module 22 | 23 | 24 | !############################################################################## 25 | ! MODULE UtilFunc 26 | !############################################################################## 27 | module UtilFunc 28 | 29 | implicit none 30 | 31 | contains 32 | 33 | 34 | ! a utility function 35 | function utility(c1, c2) 36 | 37 | use Globals 38 | 39 | implicit none 40 | real*8, intent(in) :: c1, c2 41 | real*8 :: utility 42 | 43 | utility = 1d0/(1d0-eta)*c1**(1d0-eta) + beta/(1d0-eta)*c2**(1d0-eta) 44 | 45 | end function 46 | 47 | end module 48 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_11/prog01_11.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM AlternativeArrays 3 | ! 4 | ! ## Alternative forms of array value assignments 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program AlternativeArrays 14 | 15 | implicit none 16 | integer, parameter :: n = 8 17 | real*8 :: x(0:n), y(0:n), z(0:n, 0:n) 18 | integer :: j, k 19 | 20 | ! initialize x 21 | do j = 0, n 22 | x(j) = 1d0/dble(n)*dble(j) 23 | enddo 24 | 25 | ! give y the values of x plus 1 26 | y(:) = x(:) + 1d0 27 | 28 | ! calculate z 29 | do j = 0, n 30 | do k = 0, n 31 | z(j, k) = x(j)**2 + y(k) 32 | enddo 33 | enddo 34 | 35 | ! output table of values 36 | write(*,'(a,9f7.2)')' X/Y | ', y(:) 37 | write(*,'(a)')' | ' 38 | do j = 0, n 39 | write(*,'(f7.2,a,9f7.2)')x(j),' | ', z(j, :) 40 | enddo 41 | 42 | end program 43 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_14/prog02_14.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM agriculture 3 | ! 4 | ! ## Solve the agricultural problem with discretized normal distribution 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog02_14m.f90" 14 | 15 | program agriculture 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: A, Ep, Varp 22 | logical :: check 23 | 24 | ! discretize y 25 | call normal_discrete(y, w, mu, sig2) 26 | 27 | ! initialize variables 28 | A = 1d0 29 | 30 | ! get optimum 31 | call fzero(A, market, check) 32 | 33 | ! get expectation and variance of price 34 | Ep = sum(w*max(3d0-2d0*A*y, minp)) 35 | Varp = sum(w*(max(3d0-2d0*A*y, minp) - Ep)**2) 36 | 37 | ! write output 38 | write(*,'(a,f10.3)')' A = ',A 39 | write(*,'(a,f10.3)')' E(p) = ',Ep 40 | write(*,'(a,f10.3)')' Var(p) = ',Varp 41 | 42 | end program 43 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_12/prog01_12.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Subroutines 3 | ! 4 | ! ## Store reusable code in subroutines 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Subroutines 14 | 15 | implicit none 16 | real*8 :: a, b, c, d 17 | 18 | a = 3d0 19 | b = 5d0 20 | 21 | ! call subroutine 22 | call addIt(a, b) 23 | 24 | ! redefine values 25 | c = 10d0 26 | d = 2d0 27 | 28 | ! call subroutine again 29 | call addIt(c, d) 30 | 31 | ! separates main program code from subroutine and functions 32 | contains 33 | 34 | 35 | subroutine addIt(a, b) 36 | 37 | implicit none 38 | 39 | ! input arguments 40 | real*8, intent(in) :: a, b 41 | 42 | ! other variables 43 | real*8 :: c 44 | 45 | ! executable code 46 | c = a + b 47 | write(*,'(2(f8.2,a),f8.2)')a,' + ',b,' = ',c 48 | 49 | end subroutine 50 | 51 | end program 52 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_02/prog02_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM lineqsys 3 | ! 4 | ! ## Solves a linear equation system by LU-decomposition 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program lineqsys 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer :: i, j 19 | real*8 :: A(3, 3), b(3) 20 | real*8 :: L(3, 3), U(3, 3) 21 | 22 | ! set up matrix and vector 23 | A(1, :) = (/ 2d0, 0d0, 1d0/) 24 | A(2, :) = (/ 0d0, 4d0, 1d0/) 25 | A(3, :) = (/ 1d0, 1d0, 2d0/) 26 | b = (/30d0, 40d0, 30d0/) 27 | 28 | ! solve the system 29 | call lu_solve(A, b) 30 | 31 | ! decompose matrix 32 | call lu_dec(A, L, U) 33 | 34 | ! output 35 | write(*,'(a,3f7.2/)')' x = ', (b(j),j=1,3) 36 | write(*,'(a,3f7.2/,2(5x,3f7.2/))') & 37 | ' L = ',((L(i,j),j=1,3),i=1,3) 38 | write(*,'(a,3f7.2/,2(5x,3f7.2/))') & 39 | ' U = ',((U(i,j),j=1,3),i=1,3) 40 | 41 | end program 42 | -------------------------------------------------------------------------------- /code-solution/sol_prog05/sol_prog05_01/sol_prog05_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM housing 3 | ! 4 | ! ## The life cycle model with a durable good 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog05_01m.f90" 14 | 15 | program housing 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(3) 22 | real*8 :: fret, low(3), up(3) 23 | 24 | ! lower and upper border and initial guess 25 | low = (/0d0, -a_low, -a_low/) 26 | up = (/w + a_low, w, R*w + w/) 27 | x = up/3d0 28 | 29 | ! minimization routine 30 | call fminsearch(x, fret, low, up, utility) 31 | 32 | ! output 33 | write(*,'(/a/)')' AGE CONS DCONS WAGE INC SAV UTIL' 34 | write(*,'(i4,5f7.2/)')1,c(1),ah,w,w,a(2) 35 | write(*,'(i4,5f7.2/)')2,c(2),ah,w,w+R*a(2)-delh*ah,a(3) 36 | write(*,'(i4,6f7.2)')3,c(3),ah,0d0,R*a(3)+(1d0-delh+r)*ah,0d0,-fret 37 | 38 | end program 39 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_07/prog08_07m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.95d0 18 | real*8, parameter :: a0 = 100d0 19 | 20 | ! numerical parameters 21 | real*8, parameter :: sig = 1d-6 22 | integer, parameter :: itermax = 2000 23 | 24 | ! counter variables 25 | integer :: it, ia, iter 26 | 27 | ! time path of consumption and resource 28 | integer, parameter :: TT = 200 29 | real*8 :: c_t(0:TT), a_t(0:TT) 30 | 31 | ! policy function 32 | integer, parameter :: NA = 1000 33 | real*8 :: a(0:NA), c(0:NA) 34 | 35 | ! variables to numerically determine policy function 36 | real*8 :: a_endog(0:NA), c_endog(0:NA) 37 | real*8 :: c_new(0:NA), coeff_c(NA+3) 38 | real*8 :: con_lev 39 | 40 | end module 41 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_20/prog02_20.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM simplex_alg 3 | ! 4 | ! ## The simplex algorithm for solving linear constrained minimization problems 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program simplex_alg 14 | 15 | use toolbox 16 | 17 | implicit none 18 | real*8 :: c(2), x(2), A(3, 2), b(3) 19 | integer :: j 20 | 21 | ! set up matrix, target vector and coefficients 22 | A(1, :) = (/ 1d0, 1d0/) 23 | A(2, :) = (/ 4d0, 1d0/) 24 | A(3, :) = (/20d0, 10d0/) 25 | 26 | b(:) = (/100d0, 160d0, 1100d0/) 27 | 28 | c(:) = (/-120d0, -40d0/) 29 | 30 | ! solve linear program 31 | call solve_lin(x, c, A, b, 3, 0, 0) 32 | 33 | ! output 34 | write(*,'(/a,2f10.2)')' x = ',(x(j), j=1,2) 35 | write(*,'(/a,f10.2)')' Cons 1 = ', b(1)-sum(A(1, :)*x) 36 | write(*,'(a,f10.2)')' Cons 2 = ', b(2)-sum(A(2, :)*x) 37 | write(*,'(a,f10.2)')' Cons 3 = ', b(3)-sum(A(3, :)*x) 38 | 39 | end program 40 | -------------------------------------------------------------------------------- /installation/docker/docker_base/Dockerfile: -------------------------------------------------------------------------------- 1 | # A DOCKER FILE TO BUNDLE THE CE-FORTRAN ENVIRONMENT INTO A DOCKER CONTAINER WITH GUI 2 | # 3 | # Special thanks to Lars Vilhuber for starting this project. 4 | # 5 | # This code is published under the GNU General Public License v3 6 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 7 | # 8 | # Author: Fabian Kindermann (contact@ce-fortran.com) 9 | 10 | FROM ubuntu:20.04 11 | 12 | WORKDIR /home/user 13 | 14 | # COPY SOURCEy FILES INTO BASIC DIRECTORY 15 | COPY install_fortran.sh . 16 | 17 | # COPY CE-FORTRAN PROGRAMS 18 | COPY ./code-book ./code-book 19 | 20 | # COPY CE-FORTRAN SOLUTIONS 21 | COPY ./code-solution ./code-solution 22 | 23 | # COPY TOOLBOX 24 | COPY toolbox.f90 . 25 | 26 | # ADD FONT FILE 27 | COPY ./localfonts.conf /etc/fonts/local.conf 28 | 29 | # INSTALL FORTRAN DEVELOPMENT ENVIRONMENT 30 | RUN chmod a+rx install_fortran.sh \ 31 | && DEBIAN_FRONTEND="noninteractive" TZ="Europe/Berlin" ./install_fortran.sh \ 32 | && rm -r install_fortran.sh && rm -rf /var/lib/apt/lists/* 33 | 34 | # SET ENVIRONMENT VARIABLE FOR COMPILATIONS 35 | ENV FCOMPILE="-O3 -fopenmp -frecursive -ffree-line-length-none -Wno-unused -fimplicit-none -Wall -fcheck=bound,do -ffpe-trap=invalid,zero,overflow -I/usr/local/include/ /usr/local/include/toolbox.o" 36 | 37 | 38 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_06/sol_prog02_06m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of subintervals 16 | integer, parameter :: n = 10 17 | 18 | ! old market prices 19 | real*8, parameter :: p_1 = 3d0 20 | 21 | ! new market price 22 | real*8, parameter :: p_2 = 1d0 23 | 24 | ! declaration of variables 25 | real*8 :: a, b, h, p 26 | real*8 :: d(0:n), w_trapez(0:n), f_trapez(0:n) 27 | real*8 :: d_gauss(0:n), w_gauss(0:n), f_gauss(0:n) 28 | real*8 :: trapez, simpson, gauss, CS(3, 2) 29 | 30 | contains 31 | 32 | ! thefunction to store the inverse demand function 33 | function p_func(d_in) 34 | 35 | real*8, intent(in) :: d_in 36 | real*8 :: p_func 37 | 38 | ! the inverse demand function 39 | p_func = ((d_in + 1d0)/2d0)**(-2d0) 40 | 41 | end function 42 | 43 | end module 44 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_04/sol_prog02_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! set parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0 - 1d0/gamma 18 | real*8, parameter :: r = 0d0 19 | real*8, parameter :: beta = 1d0 20 | real*8, parameter :: w = 1d0 21 | 22 | contains 23 | 24 | function utility(x_in) 25 | 26 | implicit none 27 | 28 | ! declaration of variables 29 | real*8, intent(in) :: x_in(:) 30 | real*8 :: utility 31 | real*8 :: c(3) 32 | 33 | ! define consumption levels 34 | c(2) = x_in(1) 35 | c(3) = x_in(2) 36 | c(1) = w + w/(1d0+r) - c(2)/(1d0+r) - c(3)/(1d0+r)**2d0 37 | 38 | ! set up utility we want to maximize 39 | utility = -(c(1)**egam + beta*c(2)**egam + beta**2d0*c(3)**egam)/egam 40 | 41 | end function 42 | 43 | end module 44 | -------------------------------------------------------------------------------- /code-book/prog05/prog05_01/prog05_01m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: w = 1d0 15 | real*8, parameter :: R = 1d0 16 | real*8, parameter :: beta = 1d0 17 | real*8, parameter :: gamma = 0.5d0 18 | real*8, parameter :: egam = 1d0 - 1d0/gamma 19 | 20 | real*8 :: a(3), c(3) 21 | 22 | contains 23 | 24 | 25 | ! utility function of the household 26 | function utility(x) 27 | 28 | implicit none 29 | real*8, intent(in) :: x(:) 30 | real*8 :: utility 31 | 32 | ! savings 33 | a(1) = 0d0 34 | a(2:3) = x 35 | 36 | ! consumption (insure consumption > 0) 37 | c(1) = w - a(2) 38 | c(2) = R*a(2) + w - a(3) 39 | c(3) = R*a(3) 40 | c = max(c, 1d-10) 41 | 42 | ! utility function 43 | utility = -(c(1)**egam + beta*c(2)**egam + beta**2*c(3)**egam)/egam 44 | 45 | end function 46 | 47 | end module 48 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_07/prog02_07.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM fixedpoint 3 | ! 4 | ! ## A fixed point iteration scheme to find the root of a function 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program fixedpoint 14 | 15 | implicit none 16 | integer :: iter 17 | real*8 :: xold, x, f, sigma 18 | 19 | ! set initial guess and chose sigma 20 | xold = 0.05d0 21 | sigma = 0.2d0 22 | 23 | ! start iteration process 24 | do iter = 1, 200 25 | 26 | ! calculate function value 27 | f = 0.5d0*xold**(-0.2d0)+0.5d0*xold**(-0.5d0)-2d0 28 | 29 | ! calculate new value 30 | x = xold + sigma*f 31 | 32 | write(*,'(i4,f12.7)')iter, abs(x-xold) 33 | 34 | ! check for convergence 35 | if(abs(x-xold) < 1d-6)then 36 | write(*,'(/a,f12.7,a,f12.9)')' x = ',x,' f = ',f 37 | stop 38 | endif 39 | 40 | ! copy old value 41 | xold = x 42 | enddo 43 | 44 | write(*,'(a)')'Error: no convergence' 45 | 46 | end program 47 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_09/prog02_09.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM oligopoly2 3 | ! 4 | ! ## Multi-dimensional rootfinding using the Gauss-Seidel iteration approach 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program oligopoly2 14 | 15 | implicit none 16 | real*8 :: eta = 1.6d0 17 | real*8 :: c(2) = (/ 0.6d0, 0.8d0 /) 18 | real*8 :: qold(2), q(2), QQ, damp 19 | integer :: iter 20 | 21 | ! initialize q 22 | qold = 0.1d0 23 | damp = 0.7d0 24 | 25 | do iter = 1, 100 26 | 27 | QQ = sum(qold) 28 | q = 1d0/c*(QQ**(-1d0/eta)-1d0/eta*QQ**(-1d0/eta-1d0)*qold) 29 | q = damp*q + (1d0-damp)*qold 30 | 31 | ! write to screen 32 | write(*, '(a, i5,2f10.4)')'Iter: ', iter, q(1), q(2) 33 | 34 | ! check for convergence 35 | if( all(abs(q-qold) < 1d-6))then 36 | write(*,'(/a, 2f10.4)')' Output', q(1), q(2) 37 | stop 38 | endif 39 | 40 | ! update q 41 | qold = q 42 | enddo 43 | 44 | end program 45 | 46 | 47 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_14/prog01_14.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM ArrayFunc 3 | ! 4 | ! ## Hand over arrays to functions (works the same with subroutines) 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program ArrayFunc 14 | 15 | implicit none 16 | real*8 :: a(2), b(5), res(2,5) 17 | 18 | a(:) = (/3d0, 4d0/) 19 | b(:) = (/1d0, 2d0, 3d0, 4d0, 5d0/) 20 | 21 | ! call function 22 | res = addIt(a,b) 23 | 24 | ! output 25 | write(*,'(5f8.2/5f8.2)')res(1,:),res(2,:) 26 | 27 | contains 28 | 29 | 30 | function addIt(a, b) 31 | 32 | implicit none 33 | 34 | ! input arguments 35 | real*8, intent(in) :: a(2), b(:) 36 | 37 | ! function value 38 | real*8 :: addIt(2, size(b)) 39 | 40 | ! local variables 41 | integer :: j, k 42 | 43 | ! executable code 44 | do j = 1, 2 45 | do k = 1, size(b) 46 | addIt(j,k) = a(j) + b(k) 47 | enddo 48 | enddo 49 | 50 | end function 51 | 52 | end program 53 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_02/sol_prog04_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | use toolbox 14 | 15 | implicit none 16 | real*8, parameter :: Del_TT = 62d0/250d0 ! exercise date (in annualized values) 17 | real*8, parameter :: S_0 = 25d0 ! initial stock price 18 | real*8, parameter :: r = 0.04d0 ! annual interest rate 19 | real*8, parameter :: KK = 25d0 ! strike price 20 | real*8, parameter :: c_E = 0.63d0 ! option value 21 | 22 | contains 23 | 24 | function DIFF(sigma) 25 | 26 | implicit none 27 | real*8, intent(in) :: sigma 28 | real*8 :: DIFF, d_1, d_2 29 | 30 | d_1 = (log(S_0/KK) + (r+sigma**2/2d0)*Del_TT)/sigma/sqrt(Del_TT) 31 | d_2 = d_1 - sigma*sqrt(Del_TT) 32 | DIFF = S_0*normalCDF(d_1, 0d0, 1d0) - & 33 | KK*exp(-r*Del_TT)*normalCDF(d_2, 0d0, 1d0) - c_E 34 | 35 | end function 36 | 37 | end module 38 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_03/prog08_03m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.95d0 19 | real*8, parameter :: a0 = 100d0 20 | 21 | ! numerical parameters 22 | real*8, parameter :: sig = 1d-6 23 | integer, parameter :: itermax = 2000 24 | 25 | ! counter variables 26 | integer :: it, ia, ia_p, iter 27 | 28 | ! time path of consumption and resource 29 | integer, parameter :: TT = 200 30 | real*8 :: c_t(0:TT), a_t(0:TT) 31 | integer :: ia_t(0:TT) 32 | 33 | ! value and policy function 34 | integer, parameter :: NA = 1000 35 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 36 | 37 | ! variables to numerically determine value and policy function 38 | integer :: ia_opt(0:NA) 39 | real*8 :: V_new(0:NA), u_temp(0:NA) 40 | real*8 :: con_lev, cons 41 | 42 | end module 43 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_04/prog08_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.95d0 19 | real*8, parameter :: a0 = 100d0 20 | 21 | ! numerical parameters 22 | real*8, parameter :: sig = 1d-6 23 | integer, parameter :: itermax = 2000 24 | 25 | ! counter variables 26 | integer :: it, ia, ia_p, iter 27 | 28 | ! time path of consumption and resource 29 | integer, parameter :: TT = 200 30 | real*8 :: c_t(0:TT), a_t(0:TT) 31 | integer :: ia_t(0:TT) 32 | 33 | ! value and policy function 34 | integer, parameter :: NA = 1000 35 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 36 | 37 | ! variables to numerically determine value and policy function 38 | integer :: ia_opt(0:NA) 39 | real*8 :: V_new(0:NA) 40 | real*8 :: con_lev, cons, u_temp, u_new 41 | 42 | end module 43 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_06/prog02_06.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM newton 3 | ! 4 | ! ## The Newton method to find the root of a function 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program newton 14 | 15 | implicit none 16 | integer :: iter 17 | real*8 :: xold, x, f, fprime 18 | 19 | ! set initial guess 20 | xold = 0.05d0 21 | 22 | ! start iteration process 23 | do iter = 1, 200 24 | 25 | ! calculate function value 26 | f = 0.5d0*xold**(-0.2d0)+0.5d0*xold**(-0.5d0)-2d0 27 | 28 | ! calculate derivative 29 | fprime = -0.1d0*xold**(-1.2d0)-0.25d0*xold**(-1.5d0) 30 | 31 | ! calculate new value 32 | x = xold - f/fprime 33 | 34 | write(*,'(i4,f12.7)')iter, abs(x-xold) 35 | 36 | ! check for convergence 37 | if(abs(x-xold) < 1d-6)then 38 | write(*,'(/a,f12.7,a,f12.9)')' x = ',x,' f = ',f 39 | stop 40 | endif 41 | 42 | ! copy old value 43 | xold = x 44 | enddo 45 | 46 | write(*,'(a)')'Error: no convergence' 47 | 48 | end program 49 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_06/sol_prog08_06m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.975d0 18 | real*8, parameter :: r = 0.02d0 19 | real*8, parameter :: w = 1d0 20 | real*8, parameter :: a0 = 0d0 21 | 22 | ! numerical parameters 23 | real*8, parameter :: sig = 1d-6 24 | integer, parameter :: itermax = 2000 25 | 26 | ! counter variables 27 | integer :: it, ia, iter 28 | 29 | ! time path of consumption and resource 30 | integer, parameter :: TT = 500 31 | real*8 :: c_t(0:TT), a_t(0:TT) 32 | 33 | ! policy function 34 | integer, parameter :: NA = 1000 35 | real*8 :: a(0:NA), c(0:NA) 36 | real*8 :: a_l, a_u 37 | 38 | ! variables to numerically determine policy function 39 | real*8 :: c_new(0:NA), coeff_c(NA+3) 40 | real*8 :: a_endog(0:NA), c_endog(0:NA) 41 | real*8 :: con_lev 42 | 43 | end module 44 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_09/sol_prog01_09m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of gridpoints for consumption 16 | integer, parameter :: NC = 100 17 | 18 | ! number of different values for gamma 19 | integer, parameter :: NG = 4 20 | 21 | ! initialize array for different vaues of gamma 22 | real*8, parameter :: gamma_array(NG) = (/0.25d0, 0.5d0, 0.75d0, 1.25d0/) 23 | 24 | contains 25 | 26 | ! function to compute utility 27 | function utility(c_local, gamma_local) 28 | 29 | ! input variables 30 | real*8, intent(in) :: c_local, gamma_local 31 | real*8 :: utility 32 | 33 | ! check whether c_loc > 0; otherwise print an error message 34 | if(c_local <= 0d0)then 35 | stop 'Error: c <= 0 in function utility' 36 | endif 37 | 38 | ! compute utility 39 | utility = c_local**(1d0 - 1d0/gamma_local)/(1d0 - 1d0/gamma_local) 40 | 41 | end function 42 | 43 | end module 44 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_04/sol_prog02_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Intertemporal2dim 3 | ! 4 | ! ## Solve 3 period intertemporal optimization with 2 dimensional fminsearch 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog02_04m.f90" 14 | 15 | program Intertemporal2dim 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | 22 | ! declaration of variables 23 | real*8 :: x_in(2), a(2), b(2), fret 24 | 25 | ! initialize interval for fminsearch and x_minimize 26 | a = (/0d0, 0d0/) 27 | b = (/(w + w*(1d0+r)), (w*(1d0+r) + w*(1d0+r)**2d0)/) 28 | x_in = w/2d0 29 | 30 | ! call subroutine fminsearch 31 | call fminsearch(x_in, fret, a, b, utility) 32 | 33 | ! print output 34 | write(*,'(/a)') 'Result with fminsearch:' 35 | write(*,'(a)') '-----------------------' 36 | write(*,'(a,f10.6)') 'c_1 : ', w + w/(1d0+r) - x_in(1)/(1d0+r) & 37 | - x_in(2)/(1d0+r)**2d0 38 | write(*,'(a,f10.6)') 'c_2 : ', x_in(1) 39 | write(*,'(a,f10.6)') 'c_3 : ', x_in(2) 40 | 41 | end program 42 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_07/sol_prog01_07.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM RollDice 3 | ! 4 | ! ## Simulate the result of rolling n dice with each k sides 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program RollDice 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! declaration of variables and parameters 20 | integer, parameter :: n = 2 21 | integer, parameter :: k = 6 22 | integer, parameter :: iter = 500 23 | integer :: i, j, dice(n) 24 | real*8 :: x, Dsum(n:n*k), SimProb(n:n*k) 25 | 26 | ! set random seed 27 | call init_random_seed() 28 | 29 | ! simulate dice rolls 30 | dice = 0 31 | Dsum = 0d0 32 | do i = 1, iter 33 | do j = 1, n 34 | call random_number(x) 35 | dice(j) = int(k*x) + 1 36 | enddo 37 | Dsum(sum(dice)) = Dsum(sum(dice)) + 1d0 38 | enddo 39 | SimProb = Dsum/iter*100d0 40 | 41 | ! print output 42 | write(*,'(a)')' Sum Simulated Probability (in %)' 43 | do i = n, n*k 44 | write (*,'(i5,f30.4)')i, SimProb(i) 45 | enddo 46 | 47 | end program 48 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_03/sol_prog06_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_TAUK 3 | ! 4 | ! ## The OLG model with corporate tax 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_03m.f90" 14 | 15 | program OLG_TAUK 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_17/prog02_17.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM polynomials 3 | ! 4 | ! ## Polynomial interpolation using different kinds of nodes 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program polynomials 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer, parameter :: n = 10, nplot = 1000 19 | real*8 :: xi(0:n), yi(0:n) 20 | real*8 :: xplot(0:nplot), yplot(0:nplot), yreal(0:nplot) 21 | 22 | ! get equidistant plot nodes and Runge's function 23 | call grid_Cons_Equi(xplot, -1d0, 1d0) 24 | yreal = 1d0/(1d0+25*xplot**2) 25 | call plot(xplot, yreal, legend='Original') 26 | 27 | ! equidistant polynomial interpolation 28 | call grid_Cons_Equi(xi, -1d0, 1d0) 29 | yi = 1d0/(1d0+25*xi**2) 30 | yplot = poly_interpol(xplot, xi, yi) 31 | call plot(xplot, yplot, legend='Equidistant') 32 | 33 | ! Chebyshev polynomial interpolation 34 | call grid_Cons_Cheb(xi, -1d0, 1d0) 35 | yi = 1d0/(1d0+25*xi**2) 36 | yplot = poly_interpol(xplot, xi, yi) 37 | call plot(xplot, yplot, legend='Chebyshev') 38 | 39 | ! execute plot 40 | call execplot() 41 | 42 | end program 43 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_07/sol_prog02_07m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of nodes for interpolation 16 | integer, parameter :: n = 2 17 | 18 | ! grid to evaluate plot 19 | integer, parameter :: n_plot = 10 20 | 21 | ! lower bound for interpolation 22 | real*8, parameter :: tau_l = 35d0 23 | 24 | ! upper bound for interpolation 25 | real*8, parameter :: tau_u = 45d0 26 | 27 | ! declaration of variables 28 | real*8 :: tau_data(0:n), t_data(0:n) 29 | real*8 :: tau_plot(0:n_plot), t_plot(0:n_plot) 30 | 31 | contains 32 | 33 | ! the tax function that should be maximized 34 | function tax_func(tau_in) 35 | 36 | use toolbox 37 | 38 | implicit none 39 | 40 | ! declaration of variables 41 | real*8, intent(in) :: tau_in 42 | real*8 :: tax_func 43 | 44 | ! set up the tax function we want to maximize 45 | tax_func = -poly_interpol(tau_in, tau_data, t_data) 46 | 47 | end function 48 | 49 | end module 50 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_05/sol_prog06_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_POP 3 | ! 4 | ! ## The OLG model with population growth changes 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_05m.f90" 14 | 15 | program OLG_POP 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_04/sol_prog06_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_ANNOUNCE 3 | ! 4 | ! ## The OLG model with announcement effects 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_04m.f90" 14 | 15 | program OLG_ANNOUNCE 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_06/sol_prog06_06.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_AGE 3 | ! 4 | ! ## The OLG model with variable ages and cohort sizes 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_06m.f90" 14 | 15 | program OLG_AGE 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_02/prog03_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Lbar = 20d0 16 | real*8, parameter :: alpha = 0.3d0 17 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 18 | 19 | contains 20 | 21 | 22 | ! function to determine market equilibrium 23 | function markets(x) 24 | 25 | implicit none 26 | real*8, intent(in) :: x(:) 27 | real*8 :: markets(size(x, 1)) 28 | real*8 :: Ybar, p(2), w, r 29 | 30 | ! copy prices 31 | p(1) = 1d0 32 | p(2) = x(1) 33 | w = x(2) 34 | r = x(3) 35 | 36 | ! calculate total income 37 | Ybar = w*Lbar+r*Kbar 38 | 39 | ! get market equations 40 | markets(1) = 1d0/p(1)-(beta(1)/w)**beta(1)*((1d0-beta(1))/r)**(1d0-beta(1)) 41 | markets(2) = 1d0/p(2)-(beta(2)/w)**beta(2)*((1d0-beta(2))/r)**(1d0-beta(2)) 42 | markets(3) = beta(1)*alpha*Ybar/w+beta(2)*(1-alpha)*Ybar/w-Lbar 43 | 44 | end function 45 | 46 | end module 47 | 48 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_02/sol_prog06_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_SMOPEC 3 | ! 4 | ! ## The OLG model with transitional dynamics and smopec 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_02m.f90" 14 | 15 | program OLG_SMOPEC 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_09/sol_prog08_09m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.975d0 18 | real*8, parameter :: r = 0.02d0 19 | real*8, parameter :: w = 1d0 20 | real*8, parameter :: a0 = 0d0 21 | real*8, parameter :: a_borrow = 5d0 22 | 23 | ! numerical parameters 24 | real*8, parameter :: sig = 1d-6 25 | integer, parameter :: itermax = 2000 26 | 27 | ! counter variables 28 | integer :: it, ia, iter 29 | 30 | ! time path of consumption and resource 31 | integer, parameter :: TT = 200 32 | real*8 :: c_t(0:TT), a_t(0:TT) 33 | 34 | ! policy function 35 | integer, parameter :: NA = 1000 36 | real*8 :: a(0:NA), c(0:NA) 37 | real*8 :: a_l, a_u 38 | 39 | ! variables to numerically determine policy function 40 | integer :: ia_low 41 | real*8 :: a_endog(-1:NA), c_endog(-1:NA) 42 | real*8 :: c_new(0:NA), coeff_c(NA+3) 43 | real*8 :: con_lev 44 | 45 | end module 46 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_05/sol_prog04_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM BinaryOption 3 | ! 4 | ! ## Use closed-form solution to price a Binary option 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program BinaryOption 14 | 15 | use toolbox 16 | 17 | implicit none 18 | real*8, parameter :: Del_TT = 62d0/250d0 ! exercise date (in annualized values) 19 | real*8, parameter :: S_0 = 25d0 ! initial stock price 20 | real*8, parameter :: r = 0.04d0 ! annual interest rate 21 | real*8, parameter :: sigma = 0.10d0 ! standard deviation of stock returns 22 | real*8, parameter :: KK = 25d0 ! strike price 23 | real*8, parameter :: q = 30 ! payoff at maturity 24 | 25 | real*8 :: c_BI, p_BI, d_2 26 | 27 | ! compute price of Binary call and put 28 | d_2 = (log(S_0/KK) + (r-sigma**2/2d0)*Del_TT)/sigma/sqrt(Del_TT) 29 | c_BI = q*normalCDF(d_2, 0d0, 1d0) 30 | p_BI = q*normalCDF(-d_2, 0d0, 1d0) 31 | 32 | ! write output 33 | write(*,'(a,f10.2)')'Binary Call: ', c_BI 34 | write(*,'(a,f10.2)')'Binary Put: ', p_BI 35 | 36 | end program 37 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_01/prog03_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM planner 3 | ! 4 | ! ## The social planner solution to the static general equilibrium model 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog03_01m.f90" 14 | 15 | program planner 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(2), L(2), K(2), Y(2), fret 22 | 23 | ! initial guess 24 | x(:) = 5d0 25 | 26 | ! minimization routine 27 | call fminsearch(x, fret, (/0d0, 0d0/), (/10d0, 20d0/), utility) 28 | 29 | ! solution 30 | K(1) = x(1) 31 | L(1) = x(2) 32 | K(2) = Kbar - K(1) 33 | L(2) = Lbar - L(1) 34 | Y = L**beta*K**(1d0-beta) 35 | 36 | ! output 37 | write(*,'(/a)')'GOODS MARKET 1 :' 38 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1) 39 | 40 | write(*,'(/a)')'GOODS MARKET 2 :' 41 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2) 42 | 43 | write(*,'(/a)')'LABOR MARKET :' 44 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Lbar 45 | 46 | write(*,'(/a)')'CAPITAL MARKET :' 47 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar 48 | 49 | end program 50 | -------------------------------------------------------------------------------- /code-solution/sol_prog06/sol_prog06_01/sol_prog06_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM OLG_GAUSS_SEIDEL 3 | ! 4 | ! ## The OLG model with Gauss-Seidel method for initial steady state 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog06_01m.f90" 14 | 15 | program OLG_GAUSS_SEIDEL 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | integer :: it 22 | 23 | ! initialize variables and government parameters 24 | call initialize 25 | 26 | ! compute initial long-run equilibrium 27 | call get_SteadyState 28 | 29 | ! write output 30 | open(20, file='output.out') 31 | call output(0, 20) 32 | 33 | ! initialize transitional values 34 | call get_Transition 35 | 36 | ! write output 37 | do it = 1, TT 38 | call output(it, 20) 39 | enddo 40 | close(20) 41 | 42 | open(21, file='summary.out') 43 | call output_summary(21) 44 | 45 | ! get lsra run 46 | lsra_on = .true. 47 | 48 | ! solve for the transition path 49 | call get_Transition 50 | 51 | ! write output 52 | write(21,*) 53 | call output_summary(21) 54 | close(21) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /installation/mac/uninstall_fortran.command: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A SHELL SCRIPT FOR UNINSTALLING FORTRAN FROM MACOS 4 | # 5 | # This code is published under the GNU General Public License v3 6 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 7 | # 8 | # Author: Fabian Kindermann (contact@ce-fortran.com) 9 | 10 | 11 | # set the current directory as running directory 12 | cd "$( cd "$( dirname "$0" )" && pwd )" 13 | 14 | 15 | # ASK FOR UNINSTALLATION CONFIRMATION 16 | echo 17 | echo This script uninstalls Fortran/GNU Plot/Geany from your system. 18 | echo 19 | read -rsp $'Do you want to continue (y/n)?' -n 1 key 20 | echo 21 | 22 | if [ "$key" != "y" ]; then 23 | exit 0 24 | fi 25 | 26 | 27 | # REMOVE THE TOOLBOX FILES 28 | sudo rm -f /usr/local/include/toolbox.mod 29 | sudo rm -f /usr/local/include/toolbox.o 30 | sudo rm -f /usr/local/include/toolbox_debug.o 31 | sudo rm -f /usr/local/include/toolbox_version.command 32 | 33 | 34 | # COMPLETELY UNINSTALL HOMEBREW 35 | /bin/bash -c "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/uninstall.sh)" 36 | 37 | 38 | # REMOVE GEANY APPLICATION 39 | rm -rf /Applications/Geany.app/ 40 | rm -rf ~/.config/geany/ 41 | 42 | 43 | # IF EVERYTHING RAN CORRECTLY, AT THIS POINT EVERYTHING SHOULD BE UNINSTALLED PROPERLY 44 | echo 45 | echo ...UNINSTALLATION PROCESS COMPLETED. 46 | echo 47 | echo 48 | echo In case you encountered any problem, check on www.ce-fortran.com for help. 49 | echo 50 | echo 51 | read -rsp $'Press RETURN to end...\n' -n 1 key -------------------------------------------------------------------------------- /code-solution/sol_prog05/sol_prog05_02/sol_prog05_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM housing 3 | ! 4 | ! ## The life cycle model with uncertainty on health expenditures 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog05_02m.f90" 14 | 15 | program healthexpend 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(2) 22 | real*8 :: fret, low(2), up(2) 23 | 24 | ! discretize h 25 | if(sigma /= 0d0)then 26 | call grid_Cons_Equi(hc, mu-sigma, mu+sigma) 27 | else 28 | hc = mu 29 | endif 30 | weight_h = 1d0/NH 31 | 32 | ! lower and upper border and initial guess 33 | low = (/0d0, 0d0/) 34 | up = (/w, R*w + w/) 35 | x = up/2d0 36 | 37 | ! minimization routine 38 | call fminsearch(x, fret, low, up, utility) 39 | 40 | ! output 41 | write(*,'(/a/)')' AGE CONS WAGE INC SAV EH' 42 | write(*,'(i4,4f7.2/)')1,c(1),w,w,a(2) 43 | write(*,'(i4,4f7.2/)')2,c(2),w,w+R*a(2),a(3) 44 | write(*,'(i4,5f7.2,a)')3,E(c3(:)),0d0,R*a(3),0d0,E(hc(:)),' (MEAN)' 45 | write(*,'(4x,5f7.2,a/)')Std(c3(:)),0d0,0d0,0d0,Std(hc(:)),' (STD)' 46 | 47 | end program 48 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_03/prog03_03m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Tbar = 30d0 16 | real*8, parameter :: alpha(2) = (/0.3d0, 0.4d0/) 17 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 18 | 19 | contains 20 | 21 | 22 | ! function to determine market equilibrium 23 | function markets(x) 24 | 25 | implicit none 26 | real*8, intent(in) :: x(:) 27 | real*8 :: markets(size(x, 1)) 28 | real*8 :: Ybar, p(2), w, r 29 | 30 | ! copy prices 31 | p(1) = 1d0 32 | p(2) = x(1) 33 | w = x(2) 34 | r = x(3) 35 | 36 | ! calculate total income and consumer prices 37 | Ybar = w*Tbar+r*Kbar 38 | 39 | ! get market equations 40 | markets(1) = 1d0/p(1)-(beta(1)/w)**beta(1)*((1d0-beta(1))/r)**(1d0-beta(1)) 41 | markets(2) = 1d0/p(2)-(beta(2)/w)**beta(2)*((1d0-beta(2))/r)**(1d0-beta(2)) 42 | markets(3) = beta(1)*alpha(1)*Ybar/w+beta(2)*alpha(2)*Ybar/w+ & 43 | (1d0-alpha(1)-alpha(2))*Ybar/w-Tbar 44 | 45 | end function 46 | 47 | end module 48 | 49 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_01/sol_prog01_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Calculation 3 | ! 4 | ! ## Arithmetic operations with "x" and "y" which are read from the console 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Calculation 14 | 15 | implicit none 16 | 17 | ! declaration of variables 18 | integer :: ios 19 | real*8 :: x, y 20 | real*8 :: addit, diffit, prodit, quotit 21 | 22 | ! read the first number 23 | write(*,*)'Type in the 1. real number: ' 24 | read(*,*, iostat = ios)x 25 | 26 | ! check whether input is readable 27 | if(ios /= 0)stop 'Error: number is not readable' 28 | 29 | ! read the second number 30 | write(*,*)'Type in the 2. real number: ' 31 | read(*,*, iostat = ios)y 32 | 33 | ! check whether number is readable 34 | if(ios /= 0)stop 'Error: number is not readable' 35 | 36 | ! perform arithmetic operations 37 | addit = x + y 38 | diffit = x - y 39 | prodit = x*y 40 | quotit = x/y 41 | 42 | ! print output 43 | write(*,'(a, f14.6)')'Sum =', addit 44 | write(*,'(a, f14.6)')'Difference =', diffit 45 | write(*,'(a, f14.6)')'Product =', prodit 46 | write(*,'(a, f14.6)')'Quotient =', quotit 47 | 48 | end program 49 | -------------------------------------------------------------------------------- /code-book/prog04/prog04_02/prog04_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | integer, parameter :: TT = 5 ! number of time periods 15 | integer, parameter :: NN = 3 ! number of stocks 16 | real*8, parameter :: gamma = 10d0 ! risk aversion 17 | real*8, parameter :: r_f = 0.05 ! the risk free rate 18 | 19 | real*8 :: mu(NN), sig(NN,NN) 20 | 21 | contains 22 | 23 | 24 | ! the first order conditions of the investor 25 | function focs(x_in) 26 | 27 | implicit none 28 | real*8, intent(in) :: x_in(:) 29 | real*8 :: focs(size(x_in, 1)) 30 | real*8 :: omega(NN), omega_f, eta(NN), eta_f 31 | 32 | ! copy portfolio weights 33 | omega = x_in(1:NN) 34 | omega_f = 1d0 - sum(omega) 35 | 36 | ! copy lagrangean multipliers 37 | eta = x_in(NN+1:2*NN) 38 | eta_f = x_in(2*NN+1) 39 | 40 | ! set up first order conditions 41 | focs(1:NN) = mu - r_f - gamma*matmul(sig, omega) + eta - eta_f 42 | focs(NN+1:2*NN) = omega + eta - sqrt(omega**2 + eta**2) 43 | focs(2*NN+1) = omega_f + eta_f - sqrt(omega_f**2 + eta_f**2) 44 | 45 | end function 46 | 47 | end module 48 | 49 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_02/sol_prog02_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! declaration of variables 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0 - 1d0/gamma 18 | real*8, parameter :: beta = 1d0 19 | real*8, parameter :: r = 0d0 20 | real*8, parameter :: w = 1d0 21 | 22 | contains 23 | 24 | ! the first order conditions from the lagrangian 25 | function foc(x_in) 26 | 27 | implicit none 28 | 29 | real*8, intent(in) :: x_in(:) 30 | real*8 :: foc(size(x_in, 1)) 31 | 32 | ! set up equation system to solve 33 | foc(1) = x_in(1)**(-1d0/gamma) - x_in(3) 34 | foc(2) = beta*x_in(2)**(-1d0/gamma) - x_in(3)/(1d0+r) 35 | foc(3) = w - x_in(1) - x_in(2)/(1d0+r) 36 | 37 | end function 38 | 39 | ! the utility function that should be maximized 40 | function utility(x_in) 41 | 42 | implicit none 43 | 44 | real*8, intent(in) :: x_in 45 | real*8 :: utility 46 | 47 | ! set up utility we want to maximize 48 | utility = -(x_in**egam/egam + beta*((w-x_in)*(1d0+r))**egam/egam) 49 | 50 | end function 51 | 52 | end module 53 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_01/sol_prog04_01m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | integer, parameter :: TT = 5 ! number of time periods 15 | integer, parameter :: NN = 3 ! number of stocks 16 | real*8, parameter :: gamma = 10d0 ! risk aversion 17 | real*8, parameter :: r_f = 0.04 ! the risk free rate 18 | 19 | real*8 :: mu(NN), sig(NN, NN) 20 | real*8 :: x_l(NN), x_u(NN) 21 | 22 | contains 23 | 24 | 25 | ! the utility function (risk-free) 26 | function utility_rf(x) 27 | 28 | implicit none 29 | real*8, intent(in) :: x(:) 30 | real*8 :: utility_rf 31 | real*8 :: w(NN) 32 | 33 | w = (/x(1), x(2), x(3)/) 34 | 35 | utility_rf = -(dot_product(w, mu-r_f) - 0.5d0*gamma*dot_product(w, matmul(sig, w))) 36 | 37 | end function 38 | 39 | ! the utility function 40 | function utility(x) 41 | 42 | implicit none 43 | real*8, intent(in) :: x(:) 44 | real*8 :: utility 45 | real*8 :: w(NN) 46 | 47 | w = (/x(1), x(2), 1d0-x(1)-x(2)/) 48 | 49 | utility = -(dot_product(w, mu) - 0.5d0*gamma*dot_product(w, matmul(sig, w))) 50 | 51 | end function 52 | 53 | end module 54 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_03/sol_prog01_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM SingleAndDoublePrecision 3 | ! 4 | ! ## Compare single and double precision with each other 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program SingleAndDoublePrecision 14 | 15 | implicit none 16 | 17 | ! declaration of variables 18 | real*8 :: rvar1(3), rvar2(3), x(2), y(2) 19 | integer :: i 20 | 21 | ! assign 10**9 to rvar1 22 | rvar1(1) = 10**9 23 | rvar1(2) = 10d0**9 24 | rvar1(3) = 10**9d0 25 | 26 | ! assign 10**10 to rvar2 27 | !rvar2(1) = 10**10 28 | rvar2(2) = 10d0**10 29 | rvar2(3) = 10**10d0 30 | 31 | ! print output 32 | write(*,'(a)')' Without d0 With base d0 With expo d0' 33 | write(*,'(a, 3f22.2)')'Exp 9', (rvar1(i), i = 1, 3) 34 | write(*,'(a, 3f22.2)')'Exp 10', (rvar2(i), i = 1, 3) 35 | 36 | ! assign 0.000000000003 to x with single and double precision 37 | x(1) = 0.000000000003d0 38 | x(2) = 0.000000000003 39 | 40 | write(*,'(//a, 2f30.25)')'Precision ', (x(i), i = 1, 2) 41 | 42 | ! assign 3.1415926535 to y with single and double precision 43 | y(1) = 3.1415926535d0 44 | y(2) = 3.1415926535 45 | 46 | write(*,'(//a, 2f15.12)')'Precision ', (y(i), i = 1, 2) 47 | 48 | end program 49 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_04/prog02_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM jacobi 3 | ! 4 | ! ## Use Jacobi iteration algorithm to solve linear equation system 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program jacobi 14 | 15 | implicit none 16 | integer :: iter, i 17 | real*8 :: A(3, 3), Dinv(3, 3), ID(3, 3), C(3, 3) 18 | real*8 :: b(3), d(3), x(3), xold(3) 19 | 20 | ! set up matrices and vectors 21 | A(1, :) = (/ 2d0, 0d0, 1d0/) 22 | A(2, :) = (/ 0d0, 4d0, 1d0/) 23 | A(3, :) = (/ 1d0, 1d0, 2d0/) 24 | b = (/30d0, 40d0, 30d0/) 25 | 26 | ID = 0d0 27 | Dinv = 0d0 28 | do i = 1, 3 29 | ID(i, i) = 1d0 30 | Dinv(i, i) = 1d0/A(i, i) 31 | enddo 32 | 33 | ! calculate iteration matrix and vector 34 | C = ID-matmul(Dinv, A) 35 | d = matmul(Dinv, b) 36 | 37 | ! initialize xold 38 | xold = 0d0 39 | 40 | ! start iteration 41 | do iter = 1, 200 42 | 43 | x = d + matmul(C, xold) 44 | 45 | write(*,'(i4,f12.7)')iter, maxval(abs(x-xold)) 46 | 47 | ! check for convergence 48 | if(maxval(abs(x-xold)) < 1d-6)then 49 | write(*,'(/a,3f12.2)')' x = ',(x(i),i=1,3) 50 | stop 51 | endif 52 | 53 | xold = x 54 | enddo 55 | 56 | write(*,'(a)')'Error: no convergence' 57 | 58 | end program 59 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_10/prog02_10.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM golden 3 | ! 4 | ! ## Golden search for finding the minimum of a function 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program golden 14 | 15 | implicit none 16 | real*8, parameter :: p(2) = (/1d0, 2d0/) 17 | real*8, parameter :: W = 1d0 18 | real*8 :: a, b, x1, x2, f1, f2 19 | integer :: iter 20 | 21 | ! initial interval and function values 22 | a = 0d0 23 | b = (W-p(1)*0.01d0)/p(2) 24 | 25 | ! start iteration process 26 | do iter = 1, 200 27 | 28 | ! calculate x1 and x2 and function values 29 | x1 = a + (3d0-sqrt(5d0))/2d0*(b-a) 30 | x2 = a + (sqrt(5d0)-1d0)/2d0*(b-a) 31 | f1 = -(((W-p(2)*x1)/p(1))**0.4d0 + (1d0+x1)**0.5d0) 32 | f2 = -(((W-p(2)*x2)/p(1))**0.4d0 + (1d0+x2)**0.5d0) 33 | 34 | write(*,'(i4,f12.7)')iter, abs(b-a) 35 | 36 | ! check for convergence 37 | if(abs(b-a) < 1d-6)then 38 | write(*,'(/a,f12.7)')' x_1 = ',(W-p(2)*x1)/p(1) 39 | write(*,'(a,f12.7)')' x_2 = ',x1 40 | write(*,'(a,f12.7)')' u = ',-f1 41 | stop 42 | endif 43 | 44 | ! get new values 45 | if(f1 < f2)then 46 | b = x2 47 | else 48 | a = x1 49 | endif 50 | enddo 51 | 52 | end program 53 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_09/sol_prog02_09m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: alpha = 1d0 17 | real*8, parameter :: eta = 1.5d0 18 | integer, parameter :: m = 3 19 | 20 | ! numerical parameters 21 | real*8, parameter :: p_l = 0.1d0 22 | real*8, parameter :: p_u = 3.0d0 23 | 24 | ! variables 25 | integer, parameter :: N = 10 26 | integer, parameter :: NP = 1000 27 | real*8 :: p_equi, P(0:N), q(0:N), D(0:N) 28 | real*8 :: coeff_q(N + 3), coeff_d(N + 3), p_plot(0:NP), q_s_plot(0:NP), q_d_plot(0:NP) 29 | 30 | ! communicatation variables 31 | integer :: ip_com 32 | 33 | contains 34 | 35 | ! the first order condition 36 | function foc(q_in) 37 | 38 | real*8, intent(in) :: q_in 39 | real*8 :: foc 40 | 41 | foc = p(ip_com) - q_in*p(ip_com)**(1d0+eta)/eta - alpha*sqrt(q_in) - q_in**2d0 42 | 43 | end function 44 | 45 | ! the market equilibrium 46 | function market(p_in) 47 | 48 | use toolbox 49 | 50 | real*8, intent(in) :: p_in 51 | real*8 :: market 52 | 53 | market = p_in**(-eta) - m*spline_eval(p_in, coeff_q, p_l, p_u) 54 | 55 | end function 56 | 57 | end module 58 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_02/sol_prog03_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Lbar = 20d0 16 | real*8, parameter :: alpha = 0.3d0 17 | real*8, parameter :: nu = 0.5d0 18 | real*8, parameter :: mu = 1d0-1d0/nu 19 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 20 | 21 | real*8 :: L(2), K(2), Y(2), PP, Ybar, w, r, p(2), U 22 | 23 | contains 24 | 25 | ! function to determine market equilibrium 26 | function markets(x) 27 | 28 | implicit none 29 | real*8, intent(in) :: x(:) 30 | real*8 :: markets(size(x, 1)) 31 | 32 | ! copy prices 33 | p(1) = 1d0 34 | p(2) = x(1) 35 | w = x(2) 36 | r = x(3) 37 | 38 | ! calculate total income 39 | Ybar = w*Lbar+r*Kbar 40 | PP = alpha*p(1)**(1d0-nu)+(1d0-alpha)*p(2)**(1d0-nu) 41 | 42 | ! get market equations 43 | markets(1) = 1d0/p(1)-(beta(1)/w)**beta(1)*((1d0-beta(1))/r)**(1d0-beta(1)) 44 | markets(2) = 1d0/p(2)-(beta(2)/w)**beta(2)*((1d0-beta(2))/r)**(1d0-beta(2)) 45 | markets(3) = beta(1)*alpha*Ybar/(w*p(1)**(nu-1d0)*PP)+beta(2)*(1-alpha)*Ybar/(w*p(2)**(nu-1d0)*PP)-Lbar 46 | 47 | end function 48 | 49 | end module 50 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_05/prog02_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM bisection 3 | ! 4 | ! ## A bisection method to find the root of a function 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program bisection 14 | 15 | implicit none 16 | integer :: iter 17 | real*8 :: x, a, b, fx, fa, fb 18 | 19 | ! set initial guesses and function values 20 | a = 0.05d0 21 | b = 0.25d0 22 | fa = 0.5d0*a**(-0.2d0)+0.5d0*a**(-0.5d0)-2d0 23 | fb = 0.5d0*b**(-0.2d0)+0.5d0*b**(-0.5d0)-2d0 24 | 25 | ! check whether there is a root in [a,b] 26 | if(fa*fb >= 0d0)then 27 | stop 'Error: There is no root in [a,b]' 28 | endif 29 | 30 | ! start iteration process 31 | do iter = 1, 200 32 | 33 | ! calculate new bisection point and function value 34 | x = (a+b)/2d0 35 | fx = 0.5d0*x**(-0.2d0)+0.5d0*x**(-0.5d0)-2d0 36 | 37 | write(*,'(i4,f12.7)')iter, abs(x-a) 38 | 39 | ! check for convergence 40 | if(abs(x-a) < 1d-6)then 41 | write(*,'(/a,f12.7,a,f12.9)')' x = ',x,' f = ',fx 42 | stop 43 | endif 44 | 45 | ! calculate new interval 46 | if(fa*fx < 0d0)then 47 | b = x 48 | fb = fx 49 | else 50 | a = x 51 | fa = fx 52 | endif 53 | enddo 54 | 55 | write(*,'(a)')'Error: no convergence' 56 | 57 | end program 58 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_06/prog08_06m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.95d0 18 | real*8, parameter :: a0 = 100d0 19 | 20 | ! numerical parameters 21 | real*8, parameter :: sig = 1d-6 22 | integer, parameter :: itermax = 2000 23 | 24 | ! time path of consumption and resource 25 | integer, parameter :: TT = 200 26 | real*8 :: c_t(0:TT), a_t(0:TT) 27 | 28 | ! policy function 29 | integer, parameter :: NA = 1000 30 | real*8 :: a(0:NA), c(0:NA) 31 | 32 | ! variables to numerically determine policy function 33 | real*8 :: c_new(0:NA), coeff_c(NA+3) 34 | real*8 :: con_lev, x_in 35 | logical :: check 36 | 37 | ! variables to communicate with function 38 | integer :: ia_com 39 | 40 | contains 41 | 42 | 43 | ! the first order condition 44 | function foc(x_in) 45 | 46 | use toolbox 47 | 48 | implicit none 49 | real*8, intent(in) :: x_in 50 | real*8 :: foc, cplus 51 | 52 | ! calculate right hand side of foc 53 | cplus = spline_eval(x_in, coeff_c, 0d0, a0) 54 | 55 | ! get foc 56 | foc = a(ia_com) - x_in - beta**(-gamma)*cplus 57 | 58 | end function 59 | 60 | end module 61 | -------------------------------------------------------------------------------- /installation/docker/docker_base/install_fortran.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A SHELL SCRIPT FOR INSTALLING FORTRAN TO A UBUNTU LINUX SYSTEM 4 | # 5 | # This code is published under the GNU General Public License v3 6 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 7 | # 8 | # Author: Fabian Kindermann (contact@ce-fortran.com) 9 | 10 | 11 | # INSTALL BUILD ESSENTIAL TOOLS IF NOT YET DONE 12 | apt update 13 | apt upgrade 14 | apt --yes install build-essential 15 | 16 | 17 | # INSTALL MS CORE FONTS 18 | 19 | # this part is adapted from Frank Hoffsümmer (https://github.com/captnswing/msttcorefonts) 20 | apt update 21 | apt install -y --no-install-recommends software-properties-common curl 22 | apt-add-repository multiverse 23 | apt update 24 | 25 | # ms core fonts 26 | echo "ttf-mscorefonts-installer msttcorefonts/accepted-mscorefonts-eula select true" | debconf-set-selections 27 | apt install -y --no-install-recommends fontconfig ttf-mscorefonts-installer 28 | RUN fc-cache -f -v 29 | 30 | 31 | # GFORTRAN COMPILER 32 | apt --yes install gfortran 33 | 34 | # GDB FOR DEBUGGING 35 | apt --yes install gdb 36 | 37 | # GNUPLOT 38 | apt --yes install gnuplot 39 | 40 | 41 | ## INSTALL THE TOOLBOX 42 | 43 | # compile the toolbox 44 | gfortran -c -Werror -fopenmp -Wno-unused -ffree-line-length-none -fimplicit-none -Wall -fcheck=bound,do -ffpe-trap=invalid,zero,overflow -frecursive -g ./toolbox.f90 -o toolbox_debug.o 45 | gfortran -c -O3 -fopenmp -ffree-line-length-none ./toolbox.f90 -o toolbox.o 46 | 47 | # copy the toolbox to the working directory 48 | mkdir -p /usr/local/include 49 | mv toolbox.mod /usr/local/include/ 50 | mv toolbox.o /usr/local/include/ 51 | mv toolbox_debug.o /usr/local/include/ 52 | echo "no" >> /usr/local/include/toolbox_visual.txt -------------------------------------------------------------------------------- /code-book/prog02/prog02_18/prog02_18.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM piecewise_pol 3 | ! 4 | ! ## Piecewise polynomial interpolation (linear and cubic splines) 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program piecewise_pol 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer, parameter :: n = 10, nplot = 1000 19 | real*8 :: xi(0:n), yi(0:n) 20 | real*8 :: xplot(0:nplot), yplot(0:nplot), yreal(0:nplot) 21 | real*8 :: varphi, coeff(n+3) 22 | integer :: ix, il, ir 23 | 24 | ! get nodes and data for interpolation 25 | call grid_Cons_Equi(xi, -1d0, 1d0) 26 | yi = 1d0/(1d0+25*xi**2) 27 | 28 | ! get nodes and data for plotting 29 | call grid_Cons_Equi(xplot, -1d0, 1d0) 30 | yreal = 1d0/(1d0+25*xplot**2) 31 | call plot(xplot, yreal, legend='Original') 32 | 33 | ! piecewise linear interpolation 34 | do ix = 0, nplot 35 | call linint_Equi(xplot(ix), -1d0, 1d0, n, il, ir, varphi) 36 | yplot(ix) = varphi*yi(il) + (1d0-varphi)*yi(ir) 37 | enddo 38 | call plot(xplot, yplot, legend='Piecewise linear') 39 | 40 | ! cubic spline interpolation 41 | call spline_interp(yi, coeff) 42 | do ix = 0, nplot 43 | yplot(ix) = spline_eval(xplot(ix), coeff, -1d0, 1d0) 44 | enddo 45 | call plot(xplot, yplot, legend='Cubic spline') 46 | 47 | ! execute plot 48 | call execplot(xlim=(/-1d0,1d0/)) 49 | 50 | end program 51 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_09/sol_prog01_09.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM CalcUtil 3 | ! 4 | ! ## Calculate utiltiy for different values of consumption and gamma 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog01_09m.f90" 14 | 15 | program CalcUtil 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | 22 | ! declaration of variables 23 | integer :: ic, ig 24 | real*8 :: c_read, c(NC), u(NC) 25 | character(len = 100) :: label(NG) 26 | 27 | ! read in consumption value 28 | write(*,'(a, $)')'Type in a consumption level: ' 29 | read(*,*)c_read 30 | 31 | ! print output 32 | write(*,*) 33 | do ig = 1, NG 34 | write(*,'(3(a,f8.2,2x))')'c = ', c_read, ' U = ', & 35 | utility(c_read, gamma_array(ig)), ' gamma = ', gamma_array(ig) 36 | enddo 37 | 38 | ! set up equidistant grid to plot utility to the screen 39 | do ic = 1, NC 40 | c(ic) = dble(ic)/dble(NC) 41 | enddo 42 | 43 | ! calculate and plot utility for different consumption levels 44 | do ig = 1, NG 45 | do ic = 1, NC 46 | u(ic) = utility(c(ic), gamma_array(ig)) 47 | enddo 48 | 49 | ! print output 50 | write(label(ig),'(a,f6.4)')'gamma = ', gamma_array(ig) 51 | call plot(c, u, legend=label(ig)) 52 | call execplot() 53 | enddo 54 | 55 | end program 56 | -------------------------------------------------------------------------------- /installation/mac/update_toolbox.command: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A SHELL SCRIPT FOR UPDATING THE TOOLBOX ON MACOS 4 | # 5 | # ATTENTION: Fortran must already be installed using our original installation files. 6 | # 7 | # This code is published under the GNU General Public License v3 8 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 9 | # 10 | # Author: Fabian Kindermann (contact@ce-fortran.com) 11 | 12 | 13 | # set the current directory as running directory 14 | cd "$( cd "$( dirname "$0" )" && pwd )" 15 | 16 | 17 | # ASK FOR INSTALLATION CONFIRMATION 18 | echo 19 | echo This script installs Fortran to your system. 20 | echo 21 | echo ATTENTION: Fortran must already be installed using our original installation files. 22 | echo 23 | read -rsp $'Do you want to continue (y/n)?' -n 1 key 24 | echo 25 | 26 | if [ "$key" != "y" ]; then 27 | exit 0 28 | fi 29 | 30 | 31 | ## INSTALL THE TOOLBOX 32 | 33 | # compile the toolbox 34 | gfortran -c -Werror -fopenmp -Wno-unused -ffree-line-length-none -fimplicit-none -Wall -fcheck=bound,do -ffpe-trap=invalid,zero,overflow -frecursive -g ./../toolbox/toolbox.f90 -o toolbox_debug.o 35 | gfortran -c -O3 -fopenmp -ffree-line-length-none ./../toolbox/toolbox.f90 -o toolbox.o 36 | 37 | # copy the toolbox to the working directory 38 | sudo mkdir -p /usr/local/include 39 | sudo mv toolbox.mod /usr/local/include/ 40 | sudo mv toolbox.o /usr/local/include/ 41 | sudo mv toolbox_debug.o /usr/local/include/ 42 | 43 | 44 | # IF EVERYTHING RAN CORRECTLY, AT THIS POINT EVERYTHING SHOULD BE INSTALLED PROPERLY 45 | echo 46 | echo ...TOOLBOX UPDATE COMPLETED. 47 | echo 48 | echo 49 | echo In case you encountered any problem, check on www.ce-fortran.com for help. 50 | echo 51 | echo 52 | read -rsp $'Press RETURN to end...\n' -n 1 key 53 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_03/sol_prog02_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM GoldenSearch 3 | ! 4 | ! ## Compute the market equilibrium using spline interpolation 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog02_03m.f90" 14 | 15 | program GoldenSearch 16 | 17 | use toolbox 18 | use globals 19 | 20 | implicit none 21 | 22 | ! declaration of variables 23 | real*8 :: min_global, fmin_global 24 | integer :: i_global, i 25 | 26 | ! set up n subintervals over [0,5] 27 | call grid_Cons_Equi(x, x_l, x_u) 28 | 29 | ! use the function minimize find minimum value in each interval 30 | do i = 1, n 31 | minimum_x(i) = minimize(x(i-1), x(i)) 32 | enddo 33 | 34 | ! calculate function values 35 | fmin = minimum_x*cos(minimum_x**2d0) 36 | 37 | ! locate global minimum 38 | i_global = minloc(fmin, 1) 39 | min_global = minimum_x(i_global) 40 | fmin_global = min_global*cos(min_global**2d0) 41 | 42 | ! print output to the screen 43 | write(*,'(a)')'The global minimum is lcated at' 44 | write(*,'(2(a,f10.6))')'x = ', min_global, ' y = ', fmin_global 45 | 46 | ! set up data for plot 47 | call grid_Cons_Equi(xplot, x_l, x_u) 48 | yplot = xplot*cos(xplot**2d0) 49 | 50 | ! initialize plot 51 | call plot(xplot, yplot) 52 | 53 | ! execute plot 54 | call execplot(xlabel='x', ylabel='x cos(x^2)') 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_05/sol_prog01_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM TaxFunction 3 | ! 4 | ! ## Evaluate german tax code for the income read from the console 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program TaxFunction 14 | 15 | implicit none 16 | 17 | ! declaration of variables 18 | real*8 :: y, x, z, T, average, marginal 19 | 20 | ! read the income from console 21 | write(*,'(a,$)')'Type in the income: ' 22 | read(*,*)y 23 | 24 | x = (y - 8130d0)/10000d0 25 | z = (y - 13469d0)/10000d0 26 | 27 | if(y < 8131d0)then 28 | T = 0d0 29 | average = 0d0 30 | marginal = 0d0 31 | elseif(y < 13470d0)then 32 | T = (933.70d0*x + 1400d0)*x 33 | average = T/y 34 | marginal = (1867.4d0*x + 1400d0)/10000d0 35 | elseif(y < 52882d0)then 36 | T = (228.74d0*z + 2397d0)*z + 1014d0 37 | average = T/y 38 | marginal = (457.48d0*z + 2397d0)/10000d0 39 | elseif(y < 250731d0)then 40 | T = 0.42d0*y - 8196d0 41 | average = T/y 42 | marginal = 0.42d0 43 | else 44 | T = 0.45d0*y - 15718d0 45 | average = T/y 46 | marginal = 0.45d0 47 | endif 48 | 49 | ! print output 50 | write(*,'(a, f14.6)')'tax burden: ', T 51 | write(*,'(a, f14.6)')'average tax: ', average*100d0 52 | write(*,'(a, f14.6)')'marginal tax rate:', marginal*100d0 53 | 54 | end program 55 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_02/sol_prog02_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Intertemporal 3 | ! 4 | ! ## Solve the intertemporal household optimization problem 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog02_02m.f90" 14 | 15 | program Intertemporal 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | 22 | ! declaration of variables 23 | real*8 :: x_root(3), x_minimize, a, b, fret 24 | logical :: check 25 | 26 | ! initialize x_root 27 | x_root = 0.1d0 28 | 29 | ! call subroutine fzero 30 | call fzero(x_root, foc, check) 31 | 32 | ! check whether fzero was executed correctly 33 | if(check)stop 'Error: fzero did not converge' 34 | 35 | ! print output 36 | write(*,'(a)') 'Result with fzero:' 37 | write(*,'(a)') '------------------' 38 | write(*,'(a,f10.6)') 'c_1 : ', x_root(1) 39 | write(*,'(a,f10.6)') 'c_2 : ', x_root(2) 40 | write(*,'(a,f10.6)') 'lambda : ', x_root(3) 41 | 42 | ! initialize interval for fminsearch and x_minimize 43 | a = 0d0 44 | b = w 45 | x_minimize = w/2d0 46 | 47 | ! call subroutine fminsearch 48 | call fminsearch(x_minimize, fret, a, b, utility) 49 | 50 | ! print output 51 | write(*,'(/a)') 'Result with fminsearch:' 52 | write(*,'(a)') '-----------------------' 53 | write(*,'(a,f10.6)') 'c_1 : ', x_minimize 54 | write(*,'(a,f10.6)') 'c_2 : ', (w - x_minimize)*(1d0+r) 55 | 56 | end program 57 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_04/sol_prog03_04.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM marketCESPROD 3 | ! 4 | ! ## The static general equilibrium model with CES production 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog03_04m.f90" 14 | 15 | program marketCESPROD 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x 22 | logical :: check 23 | 24 | ! initial guess 25 | x = 0.5d0 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! get utility level 37 | U = ((1d0-alpha)**(1d0/nu)*C**mu+alpha**(1d0/nu)*ell**mu)**(1d0/mu) 38 | 39 | ! output 40 | write(*,'(/a)')'GOODS MARKET 1 :' 41 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1), & 42 | ' q1 =',p(1),' p1 =',p(1) 43 | 44 | write(*,'(/a)')'GOODS MARKET 2 :' 45 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2), & 46 | ' q2 =',p(2),' p2 =',p(2) 47 | 48 | write(*,'(/a)')'LABOR MARKET :' 49 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Tbar-ell, & 50 | ' w =',w 51 | 52 | write(*,'(/a)')'CAPITAL MARKET :' 53 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar, & 54 | ' r =',r 55 | 56 | write(*,'(/a)')'UTILITY :' 57 | write(*,'(a,f6.2,2x)')' U =',U 58 | 59 | end program 60 | -------------------------------------------------------------------------------- /installation/ubuntu/uninstall_fortran.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A SHELL SCRIPT FOR UNINSTALLING FORTRAN FROM UBUNTU 4 | # 5 | # This code is published under the GNU General Public License v3 6 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 7 | # 8 | # Author: Fabian Kindermann (contact@ce-fortran.com) 9 | 10 | 11 | # set the current directory as running directory 12 | cd "$( cd "$( dirname "$0" )" && pwd )" 13 | 14 | 15 | # ASK FOR UNINSTALLATION CONFIRMATION 16 | echo 17 | echo "This script uninstalls Fortran/GNU Plot/Geany from your system." 18 | echo 19 | echo "THIS SCRIPT NEEDS ROOT PRIVILEGES FOR MANY UNINSTALLATION STEPS!!!" 20 | echo "PLEASE USE WITH CAUTION!" 21 | echo 22 | read -rsp $'Do you want to continue (y/n)?' -n 1 key 23 | echo 24 | 25 | if [ "$key" != "y" ]; then 26 | exit 0 27 | fi 28 | 29 | 30 | # REMOVE THE TOOLBOX 31 | sudo rm -f /usr/local/include/toolbox.mod 32 | sudo rm -f /usr/local/include/toolbox.o 33 | sudo rm -f /usr/local/include/toolbox_debug.o 34 | sudo rm -f /usr/local/include/toolbox_version.sh 35 | 36 | 37 | # UNINSTALL GEANY 38 | 39 | # uninstall software 40 | sudo apt --yes remove geany 41 | sudo rm -r ~/.config/geany 42 | 43 | # remove desktop icon 44 | sudo rm -f ~/Desktop/geany.desktop 45 | 46 | 47 | # UNINSTALL GNUPLOT 48 | sudo apt --yes remove gnuplot gnuplot-x11 49 | 50 | # UNINSTALL GNU FORTRAN COMPILER 51 | sudo apt --yes remove gfortran 52 | 53 | # DELETE DEPENDENCIES 54 | sudo apt --yes autoremove 55 | 56 | # CLEAN UP CONFIGURATIONS 57 | sudo sudo apt --yes clean 58 | 59 | 60 | # IF EVERYTHING RAN CORRECTLY, AT THIS POINT EVERYTHING SHOULD BE UNINSTALLED PROPERLY 61 | echo 62 | echo ...UNINSTALLATION PROCESS COMPLETED. 63 | echo 64 | echo 65 | echo In case you encountered any problem, check on www.ce-fortran.com for help. 66 | echo 67 | echo 68 | read -p "Press RETURN to end..." 69 | -------------------------------------------------------------------------------- /code-book/prog06/prog06_01/prog06_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM LR_OLG 3 | ! 4 | ! ## Long-run equilibria in the overlapping generations model 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog06_01m.f90" 14 | 15 | program LR_OLG 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | logical :: check 22 | integer :: j 23 | real*8 :: x(2) 24 | 25 | ! initialize labor supply, pension payments and tax rates 26 | LL = (2d0+n_p)/(1d0+n_p) 27 | taup = kappa/((2d0+n_p)*(1d0+n_p)) 28 | tauc = 0d0 29 | tauw = 0d0 30 | taur = 0d0 31 | 32 | ! get initial guess 33 | x(:) = 0.7d0 34 | 35 | ! solve the steady state equation system 36 | call fzero(x, eqns, check) 37 | 38 | ! check whether the solution is valid 39 | if(check)stop 'No equilibirium found !' 40 | 41 | ! calculate household utility 42 | util = 0d0 43 | do j = 1, 3 44 | util = util + beta**(j-1)*c(j)**egam/egam 45 | enddo 46 | 47 | ! Output 48 | write(*,'(a/)')' Steady state equilibrium' 49 | write(*,'(a)')' c1 c2 c3 Y w r U ' 50 | write(*,'(7f7.2/)')c(:), YY, w, r, util 51 | 52 | write(*,'(a)')' a2 a3 K ' 53 | write(*,'(3f7.2/)')a(2), a(3), KK 54 | 55 | write(*,'(a)')' tauw taur tauc taup pen B' 56 | write(*,'(6f7.2/)')tauw, taur, tauc, taup, pen, BB 57 | 58 | write(*,'(a)')' Y C G I DIFF' 59 | write(*,'(4f7.2,1f10.4)')YY,CC,GG,II,YY-CC-GG-II 60 | 61 | end program 62 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_10/sol_prog02_10m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of points for interpolation 16 | integer, parameter :: NP = 3 17 | 18 | ! number of points for evaluation 19 | integer, parameter :: Nplot = 100 20 | 21 | ! lower bound for prices 22 | real*8, parameter :: p_min = 0.5d0 23 | 24 | ! upper bound for prices 25 | real*8, parameter :: p_max = 12.5d0 26 | 27 | ! marginal costs 28 | real*8, parameter :: c = 0.1d0 29 | 30 | ! declaration of variables 31 | real*8 :: pa(0:NP), pr(0:NP), G(0:NP, 0:NP) 32 | real*8 :: pa_plot(0:Nplot), pr_plot(0:Nplot) 33 | real*8 :: coeff_G(NP+3, NP+3), G_plot(0:Nplot, 0:Nplot) 34 | 35 | contains 36 | 37 | ! the first order condition 38 | function foc(x_in) 39 | 40 | implicit none 41 | 42 | real*8, intent(in) :: x_in(:) 43 | real*8 :: foc(size(x_in, 1)) 44 | 45 | foc(1) = 10d0 - 2d0*x_in(1) - 0.5d0*x_in(2) + 1.5d0*c 46 | foc(2) = 20d0 - 2d0*x_in(2) - 0.5d0*x_in(1) + c 47 | 48 | end function 49 | 50 | ! the profit function 51 | function profit(x_in) 52 | 53 | implicit none 54 | 55 | real*8, intent(in) :: x_in(:) 56 | real*8 :: profit 57 | 58 | profit = -(x_in(1)*(10d0 - x_in(1)) + x_in(2)*(20d0 - x_in(2) - 0.5d0*x_in(1)) & 59 | - c*(10d0 - x_in(1) + 20d0 - x_in(2) - 0.5d0*x_in(1))) 60 | 61 | end function 62 | 63 | end module 64 | -------------------------------------------------------------------------------- /code-book/prog05/prog05_02/prog05_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM household2 3 | ! 4 | ! ## The life cycle model with wage risk 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog05_02m.f90" 14 | 15 | program household2 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(1+n_w) 22 | real*8 :: fret, low(1+n_w), up(1+n_w) 23 | integer :: j, iw 24 | 25 | ! discretize w 26 | call log_normal_discrete(w, weight_w, mu_w, sig_w) 27 | 28 | ! lower and upper border and initial guess 29 | low = 0d0 30 | up(1) = mu_w 31 | up(2:1+n_w) = R*mu_w+w 32 | x = up/2d0 33 | 34 | ! minimization routine 35 | call fminsearch(x, fret, low, up, utility) 36 | 37 | ! set up data for output 38 | do iw = 1, n_w 39 | wag(1,iw) = mu_w 40 | inc(1,iw) = mu_w 41 | sav(1,iw) = a(2,1) 42 | 43 | wag(2,iw) = w(iw) 44 | inc(2,iw) = w(iw)+R*a(2,1) 45 | sav(2,iw) = a(3,iw) 46 | 47 | wag(3,iw) = 0d0 48 | inc(3,iw) = R*a(3,iw) 49 | sav(3,iw) = 0d0 50 | enddo 51 | 52 | ! output 53 | write(*,'(/a/)')' AGE CONS WAGE INC SAV' 54 | do j = 1, 3 55 | write(*,'(i4,4f7.2,a)')j,E(c(j,:)),E(wag(j,:)),& 56 | E(inc(j,:)),E(sav(j,:)),' (MEAN)' 57 | write(*,'(4x,4f7.2,a/)')Std(c(j,:)),Std(wag(j,:)),& 58 | Std(inc(j,:)),Std(sav(j,:)),' (STD)' 59 | enddo 60 | 61 | write(*,'(/2(a,f6.2))')' E(w) = ',sum(weight_w*w),' Var(w) = ', & 62 | sum(weight_w*w**2)-sum(weight_w*w)**2 63 | 64 | end program 65 | -------------------------------------------------------------------------------- /code-solution/sol_prog05/sol_prog05_01/sol_prog05_01m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: w = 1d0 15 | real*8, parameter :: R = 1.0d0 16 | real*8, parameter :: beta = 1d0 17 | real*8, parameter :: theta = 0.5d0 18 | real*8, parameter :: nu = 0.5d0 19 | real*8, parameter :: gamma = 0.5d0 20 | real*8, parameter :: egam = 1d0 - 1d0/gamma 21 | real*8, parameter :: delh = 1.0d0 22 | real*8, parameter :: a_low = 0.5d0 23 | 24 | real*8 :: a(3), c(3), ah, p, u(3) 25 | 26 | contains 27 | 28 | 29 | ! utility function of the household 30 | function utility(x) 31 | 32 | implicit none 33 | real*8, intent(in) :: x(:) 34 | real*8 :: utility 35 | 36 | ! savings 37 | a(1) = 0d0 38 | ah = x(1) 39 | a(2) = x(2) 40 | a(3) = x(3) 41 | 42 | p = R - 1d0 + delh 43 | 44 | ! consumption (insure consumption > 0) 45 | c(1) = w - a(2) - ah 46 | c(2) = R*a(2) + w - a(3) - delh*ah 47 | c(3) = R*a(3) + (1d0 - p - delh)*ah 48 | c = max(c, 1d-10) 49 | ah = max(ah, 1d-10) 50 | 51 | ! utility function 52 | u(1) = (theta*c(1)**nu+(1d0-theta)*ah**nu)**(egam/nu)/egam 53 | u(2) = (theta*c(2)**nu+(1d0-theta)*ah**nu)**(egam/nu)/egam 54 | u(3) = (theta*c(3)**nu+(1d0-theta)*ah**nu)**(egam/nu)/egam 55 | 56 | utility = -(u(1) + beta*u(2) + beta**2*u(3)) 57 | 58 | end function 59 | 60 | end module 61 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_02/prog08_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM dynamic 3 | ! 4 | ! ## The dynamic solution to the cake eating problem 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program dynamic 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! model parameters 20 | real*8, parameter :: gamma = 0.5d0 21 | real*8, parameter :: egam = 1d0-1d0/gamma 22 | real*8, parameter :: beta = 0.95d0 23 | real*8, parameter :: a0 = 100d0 24 | 25 | ! other variables 26 | integer :: it, ia 27 | 28 | integer, parameter :: TT = 200 29 | real*8 :: c_t(0:TT), a_t(0:TT) 30 | 31 | integer, parameter :: NA = 1000 32 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 33 | 34 | ! calculate the time path of consumption 35 | a_t(0) = a0 36 | c_t(0) = a_t(0)*(1d0-beta**gamma) 37 | do it = 1, TT 38 | a_t(it) = a_t(it-1) - c_t(it-1) 39 | c_t(it) = a_t(it)*(1d0-beta**gamma) 40 | enddo 41 | 42 | call plot((/(dble(it),it=0,TT)/), c_t) 43 | call execplot(xlabel='Time t', ylabel='Consumption c_t') 44 | 45 | ! plot policy and value function 46 | do ia = 0, NA 47 | a(ia) = 1d0 + dble(ia)/dble(NA)*a0 48 | c(ia) = a(ia)*(1d0-beta**gamma) 49 | V(ia) = (1d0-beta**gamma)**(-1d0/gamma)*a(ia)**egam/egam 50 | enddo 51 | 52 | ! plot policy function 53 | call plot(a, c) 54 | call execplot(xlabel='Level of resources a', ylabel='Policy Function c(a)') 55 | 56 | ! plot value function 57 | call plot(a, V) 58 | call execplot(xlabel='Level of Resources a', ylabel='Value Function V(a)') 59 | 60 | end program 61 | -------------------------------------------------------------------------------- /code-book/prog08/prog08_05/prog08_05m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.95d0 19 | real*8, parameter :: a0 = 100d0 20 | 21 | ! numerical parameters 22 | real*8, parameter :: sig = 1d-6 23 | integer, parameter :: itermax = 2000 24 | 25 | ! time path of consumption and resource 26 | integer, parameter :: TT = 200 27 | real*8 :: c_t(0:TT), a_t(0:TT) 28 | 29 | ! value and policy function 30 | integer, parameter :: NA = 1000 31 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 32 | 33 | ! variables to numerically determine value and policy function 34 | real*8 :: V_new(0:NA), coeff_V(NA+3), coeff_c(NA+3) 35 | real*8 :: con_lev, x_in, fret 36 | 37 | ! variables to communicate with function 38 | integer :: ia_com 39 | 40 | contains 41 | 42 | 43 | ! the function that should be minimized 44 | function utility(x_in) 45 | 46 | use toolbox 47 | 48 | implicit none 49 | real*8, intent(in) :: x_in 50 | real*8 :: utility, cons, vplus 51 | 52 | ! calculate consumption 53 | cons = max(a(ia_com) - x_in, 1d-10) 54 | 55 | ! calculate future utility 56 | vplus = max(spline_eval(x_in, coeff_V, 0d0, a0), 1d-10)**egam/egam 57 | 58 | ! get utility function 59 | utility = - (cons**egam/egam + beta*vplus) 60 | 61 | end function 62 | 63 | end module 64 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_12/sol_prog04_12m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | use toolbox 14 | implicit none 15 | integer, parameter :: TT = 16 ! maximum age of individuals 16 | integer, parameter :: NN = 1000 ! number of insured people 17 | integer, parameter :: x = 8, d = 9 ! initial age and contract duration 18 | real*8, parameter :: r = 0.16d0 ! interest rate 19 | real*8, parameter :: xi_2 = 0.05d0 ! discount factor for premium calculation 20 | 21 | real*8 :: k(0:(TT-x+1)), rand, q(TT) 22 | real*8 :: agg_LI(NN), ind_LI(NN) 23 | integer :: in 24 | 25 | contains 26 | 27 | subroutine init_borders() 28 | 29 | implicit none 30 | real*8 :: PP 31 | integer :: ij 32 | 33 | ! Compute right borders of intervals 34 | k(0) = 0d0 35 | PP = 1.0d0 36 | do ij = 1, TT-x+1 37 | k(ij) = k(ij-1) + q(x+ij-1)*PP 38 | PP = PP*(1.0d0-q(x+ij-1)) 39 | enddo 40 | 41 | end subroutine 42 | 43 | function get_LI(rand) 44 | 45 | implicit none 46 | real*8, intent(in) :: rand 47 | real*8 :: get_LI 48 | integer :: ij 49 | 50 | get_LI = 0d0 51 | do ij = 1, TT-x+1 52 | if(rand < k(ij) .and. ij <= d)then 53 | get_LI = 1d0/(1d0+r)**ij 54 | exit 55 | endif 56 | enddo 57 | 58 | end function get_LI 59 | 60 | end module globals 61 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_17/prog01_17.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Plotgraphs 3 | ! 4 | ! ## How to plot graphs with the plotting functions from the toolbox 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Plotgraphs 14 | 15 | use toolbox 16 | 17 | implicit none 18 | real*8 :: x(0:100), y(0:100) 19 | integer :: i1 20 | 21 | ! Initialize x values 22 | do i1 = 0, 100 23 | x(i1) = 1d0/100d0*dble(i1) 24 | enddo 25 | 26 | ! Calculate plot data 27 | y = x**2 28 | call plot(x, y) 29 | 30 | ! execute plot program 31 | call execplot() 32 | 33 | ! Calculate data for roots 34 | y = x**(1d0/2d0) 35 | 36 | ! you can specify a legend entry in the plot as follows 37 | call plot(x, y, legend='square root') 38 | 39 | ! the same for a cubic root 40 | y = x**(1d0/3d0) 41 | call plot(x, y, legend='cubic root') 42 | 43 | ! execute plot program and give the plot a title 44 | call execplot(title='Roots') 45 | 46 | ! plot has many more options that are specified here 47 | y = x**(1d0/2d0) 48 | call plot(x, y, color='green', linewidth=3d0, marker=2, & 49 | markersize=0.7d0, noline=.false., legend='square root') 50 | 51 | y = x**(1d0/3d0) 52 | call plot(x, y, color='#5519D6', marker=5, markersize=1.2d0, & 53 | noline=.true., legend='cubic root') 54 | 55 | call execplot(xlim=(/0d0, 1.1d0/), xticks=0.1d0, & 56 | xlabel='x-Axis', ylim=(/0d0, 1.4d0/), yticks=0.2d0, & 57 | ylabel='y-Axis', title='Roots', legend='rs', & 58 | filename='testplot', filetype='eps', output='testdata') 59 | 60 | end program 61 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_02/sol_prog03_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM program marketCES 3 | ! 4 | ! ## The market equilibrium solution for static general equilibrium model (CES) 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog03_02m.f90" 14 | 15 | program marketCES 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(3) 22 | logical :: check 23 | 24 | ! initial guess 25 | x(:) = 0.5d0 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! calculate other economic variables 37 | Y(1) = alpha*Ybar/p(1)**nu/PP 38 | Y(2) = (1d0-alpha)*Ybar/p(2)**nu/PP 39 | L = beta*p*Y/w 40 | K = (1d0-beta)*p*Y/r 41 | U = (alpha**(1d0/nu)*Y(1)**mu+(1d0-alpha)**(1d0/nu)*Y(2)**mu)**(1d0/mu) 42 | 43 | ! output 44 | write(*,'(/a)')'GOODS MARKET 1 :' 45 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1), & 46 | ' q1 =',p(1),' p1 =',p(1) 47 | 48 | write(*,'(/a)')'GOODS MARKET 2 :' 49 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2), & 50 | ' q2 =',p(2),' p2 =',p(2) 51 | 52 | write(*,'(/a)')'LABOR MARKET :' 53 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Lbar, & 54 | ' w =',w 55 | 56 | write(*,'(/a)')'CAPITAL MARKET :' 57 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar, & 58 | ' r =',r 59 | 60 | write(*,'(/a)')'UTILITY :' 61 | write(*,'(a,f6.2,2x)')' U =',U 62 | 63 | end program 64 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_01/sol_prog02_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Matrices 3 | ! 4 | ! ## Perform lu-decomposition and solve linear equation system 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Matrices 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! declaration of variables 20 | real*8 :: A(4, 4), L(4, 4), U(4, 4), A_test(4, 4), b(4), b_test(4) 21 | integer :: i, j 22 | 23 | ! initialize matrix A 24 | A(1, :) = (/1d0, 5d0, 2d0, 3d0/) 25 | A(2, :) = (/1d0, 6d0, 8d0, 6d0/) 26 | A(3, :) = (/1d0, 6d0, 11d0, 2d0/) 27 | A(4, :) = (/1d0, 7d0, 17d0, 4d0/) 28 | 29 | ! initialize vector b 30 | b = (/1d0, 2d0, 1d0, 1d0/) 31 | 32 | ! print matrix A to the screen 33 | write(*,'(a)')'A = ' 34 | write(*,'(4f7.1)')((A(j, i),i = 1, 4), j = 1, 4) 35 | 36 | ! decompose matrix A 37 | call lu_dec(A, L, U) 38 | 39 | ! check the result from lu_dec 40 | A_test = matmul(L, U) 41 | 42 | ! print output 43 | write(*,'(a)')'L = ' 44 | write(*,'(4f7.1)')((L(j, i), i = 1,4), j = 1, 4) 45 | write(*,'(/a)')'U = ' 46 | write(*,'(4f7.1)')((U(j, i), i = 1, 4), j = 1, 4) 47 | write(*,'(/a)')'A_test = ' 48 | write(*,'(4f7.1)')((A_test(j, i), i = 1, 4), j = 1, 4) 49 | write(*,'(/a/)')'-----------------------------' 50 | 51 | ! solve the linear equation system 52 | call lu_solve(A, b) 53 | 54 | ! check the result from lu_solve 55 | b_test = matmul(A, b) 56 | 57 | ! print output 58 | write(*,'(a)')'b = ' 59 | write(*,'(4f7.1)')(b(i), i = 1, 4) 60 | write(*,'(/a)')'b_test = ' 61 | write(*,'(4f7.1)')(b_test(i), i = 1, 4) 62 | 63 | end program 64 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_03/sol_prog03_03m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Tbar = 30d0 16 | real*8, parameter :: alpha = 0.3d0 17 | real*8, parameter :: alphax = 0.5d0 18 | real*8, parameter :: nu = 0.5d0 19 | real*8, parameter :: nux = 0.5d0 20 | real*8, parameter :: mu = 1d0-1d0/nu 21 | real*8, parameter :: mux = 1d0-1d0/nux 22 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 23 | 24 | real*8 :: Ybar, Omega, PP, w, r, p(2), L(2), K(2), Y(2), U 25 | real*8 :: YD, C, ell 26 | 27 | contains 28 | 29 | ! function to determine market equilibrium 30 | function markets(x) 31 | 32 | implicit none 33 | real*8, intent(in) :: x(:) 34 | real*8 :: markets(size(x, 1)) 35 | 36 | ! copy prices 37 | p(1) = 1d0 38 | p(2) = x(1) 39 | w = x(2) 40 | r = x(3) 41 | 42 | ! calculate total income 43 | Ybar = w*Tbar+r*Kbar 44 | PP = alphax*p(1)**(1-nux) + (1d0-alphax)*p(2)**(1d0-nux) 45 | Omega = (1-alpha)*PP**(1-nu) + alpha*w**(1-nu) 46 | 47 | ! get market equations 48 | markets(1) = 1d0/p(1)-(beta(1)/w)**beta(1)*((1d0-beta(1))/r)**(1d0-beta(1)) 49 | markets(2) = 1d0/p(2)-(beta(2)/w)**beta(2)*((1d0-beta(2))/r)**(1d0-beta(2)) 50 | markets(3) = (beta(1)*alphax/p(1)**(nux-1d0)+beta(2)*(1d0-alphax)/p(2)**(nux-1d0))* & 51 | (w**(nu-1d0)*Omega-alpha)/(w**nu*Omega*PP)*Ybar+alpha*Ybar/w**nu/Omega-Tbar 52 | 53 | end function 54 | 55 | end module 56 | -------------------------------------------------------------------------------- /code-solution/sol_prog05/sol_prog05_03/sol_prog05_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM household2 3 | ! 4 | ! ## The life cycle model with wage risk 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog05_03m.f90" 14 | 15 | program household2 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(1 + n_w) 22 | real*8 :: fret, low(1 + n_w), up(1 + n_w) 23 | integer :: j, iw 24 | 25 | ! discretize w 26 | w = (/0d0, 1d0/) 27 | weight_w(1) = 0.5d0 28 | weight_w(2) = 1d0 - weight_w(1) 29 | 30 | ! lower and upper border and initial guess 31 | low = 0d0 32 | up(1) = mu_w 33 | up(2:1 + n_w) = R*mu_w + w 34 | x = up/2d0 35 | 36 | ! minimization routine 37 | call fminsearch(x, fret, low, up, utility) 38 | 39 | ! set up data for output 40 | do iw = 1, n_w 41 | wag(1, iw) = mu_w 42 | inc(1, iw) = mu_w 43 | sav(1, iw) = a(2, 1) 44 | 45 | wag(2, iw) = w(iw) 46 | inc(2, iw) = w(iw) + R*a(2, 1) 47 | sav(2, iw) = a(3, iw) 48 | 49 | wag(3, iw) = 0d0 50 | inc(3, iw) = R*a(3, iw) 51 | sav(3, iw) = 0d0 52 | enddo 53 | 54 | ! output 55 | write(*,'(/a/)')' AGE CONS WAGE INC SAV' 56 | do j = 1, 3 57 | write(*,'(i4,4f7.2,a)')j,E(c(j,:)),E(wag(j,:)),& 58 | E(inc(j,:)),E(sav(j,:)),' (MEAN)' 59 | write(*,'(4x,4f7.2,a/)')Std(c(j,:)),Std(wag(j,:)),& 60 | Std(inc(j,:)),Std(sav(j,:)),' (STD)' 61 | enddo 62 | 63 | write(*,'(/2(a,f6.2))')' E(w) = ',sum(weight_w*w),' Var(w) = ', & 64 | sum(weight_w*w**2)-sum(weight_w*w)**2 65 | 66 | write(*,'(/a,f6.3)')'utility = ', -fret 67 | 68 | end program 69 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_05/sol_prog03_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM marketCESTAX 3 | ! 4 | ! ## The static general equilibrium model with CES production and Government 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog03_05m.f90" 14 | 15 | program marketCESTAX 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(2) 22 | logical :: check 23 | 24 | ! initial guess 25 | x(:) = (/0.5d0, 0.4d0/) 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! get utility level 37 | U = ((1d0-alpha)**(1d0/nu)*C**mu+alpha**(1d0/nu)*ell**mu)**(1d0/mu) 38 | 39 | ! output 40 | write(*,'(/a)')'GOODS MARKET 1 :' 41 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1), & 42 | ' q1 =',p(1),' p1 =',p(1) 43 | 44 | write(*,'(/a)')'GOODS MARKET 2 :' 45 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2), & 46 | ' q2 =',p(2),' p2 =',p(2) 47 | 48 | write(*,'(/a)')'LABOR MARKET :' 49 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Tbar-ell, & 50 | ' w =',w 51 | 52 | write(*,'(/a)')'CAPITAL MARKET :' 53 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar, & 54 | ' r =',r 55 | 56 | write(*,'(/a)')'GOVERNMENT :' 57 | write(*,'(6(a,f6.2,2x))')' tc1=',tauc(1)*q(1)*Xd(1), & 58 | ' tc2=',tauc(2)*q(2)*Xd(2),' tw =',tauw*w*(Tbar-ell), & 59 | ' tr =',taur*r*Kbar,' G =',q(1)*G 60 | 61 | write(*,'(/a)')'UTILITY :' 62 | write(*,'(a,f6.2,2x)')' U =',U 63 | 64 | end program 65 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_02/prog03_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM market1 3 | ! 4 | ! ## The market equilibrium solution to the static general equilibrium model 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog03_02m.f90" 14 | 15 | program market1 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(3), L(2), K(2), Y(2), Ybar, w, r, p(2), U 22 | logical :: check 23 | 24 | ! initial guess 25 | x(:) = 0.5d0 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! copy prices 37 | p(1) = 1d0 38 | p(2) = x(1) 39 | w = x(2) 40 | r = x(3) 41 | 42 | ! calculate other economic variables 43 | Ybar = w*Lbar+r*Kbar 44 | Y(1) = alpha*Ybar/p(1) 45 | Y(2) = (1d0-alpha)*Ybar/p(2) 46 | L = beta*p*Y/w 47 | K = (1d0-beta)*p*Y/r 48 | U = Y(1)**alpha*Y(2)**(1d0-alpha) 49 | 50 | ! output 51 | write(*,'(/a)')'GOODS MARKET 1 :' 52 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1), & 53 | ' q1 =',p(1),' p1 =',p(1) 54 | 55 | write(*,'(/a)')'GOODS MARKET 2 :' 56 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2), & 57 | ' q2 =',p(2),' p2 =',p(2) 58 | 59 | write(*,'(/a)')'LABOR MARKET :' 60 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Lbar, & 61 | ' w =',w 62 | 63 | write(*,'(/a)')'CAPITAL MARKET :' 64 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar, & 65 | ' r =',r 66 | 67 | write(*,'(/a)')'UTILITY :' 68 | write(*,'(a,f6.2,2x)')' U =',U 69 | 70 | end program 71 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The ce-fortran Code and Compiler Repository 2 | 3 | This program and compiler repository accompanies our textbook 4 | 5 | [Fehr and Kindermann (2018), Introduction to Computational Economics Using Fortran, Oxford University Press.](https://global.oup.com/academic/product/introduction-to-computational-economics-using-fortran-9780198804406?prevSortField=1&sortField=8&start=0&resultsPerPage=20&prevNumResPerPage=20&lang=en&cc=no) 6 | 7 | as well as its exercise and solution manual. Here you will find all the programs we describe in the book as well as detailed information on how to install free Fortran compilers. In addition we show you how to install our toolbox. This toolbox contains ample numerical routines as well as a plotting interface for GNUPlot. 8 | 9 | Just download or clone this repository and you will be able to install a suitable Fortran compiler on your operating system such that you can study all codes that come with the books. 10 | 11 | ## Structure of this respository 12 | 13 | 1. All Fortran codes for the book are stored in the folder [code-book](https://github.com/fabiankindermann/ce-fortran/tree/main/code-book). 14 | 2. All Fortran codes for the solution manual are stored in the folder [code-solution](https://github.com/fabiankindermann/ce-fortran/tree/main/code-solution). 15 | 3. Installation instructions and packages for different operating systems as well as Docker containers can be found in the folder [installation](https://github.com/fabiankindermann/ce-fortran/tree/main/installation). Just choose your operating system and learn how to install a Fortran compiler and our toolbox on your computer. Refer to the `README.md` files for further instructions. 16 | 17 | ## Wiki 18 | 19 | In our [wiki](https://github.com/fabiankindermann/ce-fortran/wiki), you can find a full documentation of the ce-fortran toolbox as well as further links that you might find useful. 20 | 21 | ## I need help or support! 22 | 23 | The best way to get help or support is to [start a discussion](https://github.com/fabiankindermann/ce-fortran/discussions). We are trying to be as quick as possible in providing responses to your questions. -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_07/sol_prog02_07.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM TaxFunction 3 | ! 4 | ! ## Compute the optimal tax-rate with the help of polynomial interpolation 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog02_07m.f90" 14 | 15 | program TaxFunction 16 | 17 | use toolbox 18 | use globals 19 | 20 | implicit none 21 | 22 | ! declaration of variables 23 | integer :: i_max 24 | real*8 :: tau_opt, t_opt, tau_in, fret 25 | 26 | ! initialize data for interpolation 27 | tau_data = (/37d0, 42d0, 45d0/) 28 | t_data = (/198.875d0, 199.50d0, 196.875d0/) 29 | 30 | ! plot tax function with polynomial interpolation on equidistant grid 31 | call grid_Cons_Equi(tau_plot, tau_l, tau_u) 32 | t_plot = poly_interpol(tau_plot, tau_data, t_data) 33 | 34 | ! plot tax function 35 | call plot(tau_plot, t_plot) 36 | call execplot(xlabel='Tax rate',ylabel='Tax Revenue') 37 | 38 | ! find maximum tax-rate using the maxloc command 39 | i_max = maxloc(t_plot, 1) - 1 40 | tau_opt = tau_plot(i_max) 41 | t_opt = t_plot(i_max) 42 | 43 | ! print output 44 | write(*,'(a)') 'maxloc' 45 | write(*,'(a)') '------' 46 | write(*,'(a,f8.2, a)') 'Optimal tax rate: ', tau_opt, ' %' 47 | write(*,'(a, f8.2,a)') 'Max tax revenue: ', t_opt, ' Mrd.' 48 | 49 | ! initialize initial guess for tau_in 50 | tau_in = 37.5d0 51 | 52 | ! call subroutine fminsearch 53 | call fminsearch(tau_in, fret, tau_l, tau_u, tax_func) 54 | 55 | ! print output 56 | write(*,'(/a)') 'fminsearch' 57 | write(*,'(a)') '----------' 58 | write(*,'(a,f8.2, a)') 'Optimal tax rate: ', tau_in, ' %' 59 | write(*,'(a, f8.2,a)') 'Max tax revenue: ', -fret, ' Mrd.' 60 | 61 | end program 62 | -------------------------------------------------------------------------------- /installation/ubuntu/update_toolbox.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # A SHELL SCRIPT FOR UPDATING THE TOOLBOX ON UBUNTU 4 | # 5 | # ATTENTION: Fortran must already be installed using our original installation files. 6 | # 7 | # This code is published under the GNU General Public License v3 8 | # (https://www.gnu.org/licenses/gpl-3.0.en.html) 9 | # 10 | # Author: Fabian Kindermann (contact@ce-fortran.com) 11 | 12 | 13 | # set the current directory as running directory 14 | cd "$( cd "$( dirname "$0" )" && pwd )" 15 | 16 | 17 | # CHECK WHETHER THE SCRIPT HAS ROOT PRIVILIGES 18 | [ "$UID" -eq 0 ] || { echo ; echo "THIS SCRIPT NEEDS TO BE RUN WITH ROOT PRIVILEGES!!!" ; echo ; echo "If you don't want this, use our docker images." ; echo ; echo "PLEASE TYPE YOUR PASSWORD:"; exec sudo "$0" "$@";} 19 | 20 | 21 | # ASK FOR INSTALLATION CONFIRMATION 22 | echo 23 | echo "This script installs Fortran to your system." 24 | echo 25 | echo "ATTENTION: Fortran must already be installed using our original installation files." 26 | echo 27 | echo "THIS SCRIPT NEEDS ROOT PRIVILEGES FOR SOME INSTALLATION STEPS!!!" 28 | echo 29 | read -rsp $'Do you want to continue (y/n)?' -n 1 key 30 | echo 31 | 32 | if [ "$key" != "y" ]; then 33 | exit 0 34 | fi 35 | 36 | 37 | ## INSTALL THE TOOLBOX 38 | 39 | # compile the toolbox 40 | gfortran -c -Werror -fopenmp -Wno-unused -ffree-line-length-none -fimplicit-none -Wall -fcheck=bound,do -ffpe-trap=invalid,zero,overflow -frecursive -g ./../toolbox/toolbox.f90 -o toolbox_debug.o 41 | gfortran -c -O3 -fopenmp -ffree-line-length-none ./../toolbox/toolbox.f90 -o toolbox.o 42 | 43 | # copy the toolbox to the working directory 44 | sudo mkdir -p /usr/local/include 45 | sudo mv toolbox.mod /usr/local/include/ 46 | sudo mv toolbox.o /usr/local/include/ 47 | sudo v toolbox_debug.o /usr/local/include/ 48 | 49 | 50 | # IF EVERYTHING RAN CORRECTLY, AT THIS POINT EVERYTHING SHOULD BE INSTALLED PROPERLY 51 | echo 52 | echo ...TOOLBOX UPDATE COMPLETED. 53 | echo 54 | echo 55 | echo In case you encountered any problem, check on www.ce-fortran.com for help. 56 | echo 57 | echo 58 | read -p "Press RETURN to end..." 59 | -------------------------------------------------------------------------------- /code-book/prog09/prog09_01/prog09_01m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.99d0 18 | real*8, parameter :: alpha = 0.40d0 19 | real*8, parameter :: delta = 0.019d0 20 | real*8, parameter :: k0 = 10d0 21 | 22 | ! numerical parameters 23 | real*8, parameter :: k_l = 5d0 24 | real*8, parameter :: k_u = 100d0 25 | real*8, parameter :: sig = 1d-6 26 | integer, parameter :: itermax = 2000 27 | 28 | ! counter variables 29 | integer :: it, ik, iter 30 | 31 | ! time path of consumption and capital 32 | integer, parameter :: TT = 360 33 | real*8 :: c_t(0:TT), k_t(0:TT), y_t(0:TT) 34 | 35 | ! policy function 36 | integer, parameter :: NK = 100 37 | real*8 :: k(0:NK), c(0:NK) 38 | 39 | ! variables to numerically determine policy function 40 | real*8 :: c_new(0:NK), coeff_c(NK+3) 41 | real*8 :: con_lev, x_in 42 | logical :: check 43 | 44 | ! variables to communicate with function 45 | real*8 :: k_com 46 | 47 | contains 48 | 49 | 50 | ! the first order condition 51 | function foc(x_in) 52 | 53 | use toolbox 54 | 55 | implicit none 56 | real*8, intent(in) :: x_in 57 | real*8 :: foc, kplus, cplus 58 | 59 | ! future capital 60 | kplus = (1d0-delta)*k_com + k_com**alpha - x_in 61 | 62 | ! calculate future consumption 63 | cplus = spline_eval(kplus, coeff_c, k_l, k_u) 64 | 65 | ! get first order condition 66 | foc = x_in - (beta*(1d0+alpha*kplus**(alpha-1d0)-delta))**(-gamma)*cplus 67 | 68 | end function 69 | 70 | end module 71 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_05/sol_prog08_05m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.975d0 18 | real*8, parameter :: r = 0.02d0 19 | real*8, parameter :: w = 1d0 20 | real*8, parameter :: a0 = 0d0 21 | 22 | ! numerical parameters 23 | real*8, parameter :: sig = 1d-6 24 | integer, parameter :: itermax = 2000 25 | 26 | ! time path of consumption and resource 27 | integer, parameter :: TT = 500 28 | real*8 :: c_t(0:TT), a_t(0:TT) 29 | 30 | ! value and policy function 31 | integer, parameter :: NA = 1000 32 | real*8 :: a(0:NA), c(0:NA) 33 | real*8 :: a_l, a_u 34 | 35 | ! variables to numerically determine value and policy function 36 | real*8 :: c_new(0:NA), coeff_c(NA+3) 37 | real*8 :: con_lev, x_in, fret 38 | logical :: check 39 | 40 | ! variables to communicate with function 41 | integer :: ia_com 42 | 43 | contains 44 | 45 | 46 | ! the first order condition 47 | function foc(x_in) 48 | 49 | use toolbox 50 | 51 | ! variable declarations 52 | real*8, intent(in) :: x_in 53 | real*8 :: foc, cplus 54 | 55 | ! calculate right hand side of foc 56 | cplus = spline_eval(min(x_in, a_u), coeff_c, a_l, a_u) 57 | 58 | ! extrapolate if x_in goes beyond a_u 59 | if(x_in > a_u)then 60 | cplus = cplus + (x_in-a_u)*(c(NA)-c(NA-1))/(a(NA)-a(NA-1)) 61 | endif 62 | 63 | ! get foc 64 | foc = (1d0+r)*a(ia_com) + w - x_in - (beta*(1d0+r))**(-gamma)*cplus 65 | 66 | end function 67 | 68 | end module 69 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_03/sol_prog03_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM marketCESLabour 3 | ! 4 | ! ## The static general equilibrium model with variable labour supply (CES) 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog03_03m.f90" 14 | 15 | program marketCESLabour 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(3) 22 | logical :: check 23 | 24 | ! initial guess 25 | x(:) = 0.3d0 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! calculate other economic variables 37 | C = (1d0-alpha)*Ybar/PP**nu/Omega 38 | ell = alpha*Ybar/(w**nu*Omega) 39 | YD = Ybar-w*ell 40 | Y(1) = alphax*YD/p(1)**nux/PP 41 | Y(2) = (1d0-alphax)*YD/p(2)**nux/PP 42 | L = beta*p*Y/w 43 | K = (1d0-beta)*p*Y/r 44 | U = ((1d0-alpha)**(1d0/nu)*C**mu+alpha**(1d0/nu)*ell**mu)**(1d0/mu) 45 | 46 | ! output 47 | write(*,'(/a)')'GOODS MARKET 1 :' 48 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1), & 49 | ' q1 =',p(1),' p1 =',p(1) 50 | 51 | write(*,'(/a)')'GOODS MARKET 2 :' 52 | write(*,'(4(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2), & 53 | ' q2 =',p(2),' p2 =',p(2) 54 | 55 | write(*,'(/a)')'LABOR MARKET :' 56 | write(*,'(4(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' L =',Tbar-ell, & 57 | ' w =',w 58 | 59 | write(*,'(/a)')'CAPITAL MARKET :' 60 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar, & 61 | ' r =',r 62 | 63 | write(*,'(/a)')'UTILITY :' 64 | write(*,'(a,f6.2,2x)')' U =',U 65 | 66 | end program 67 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_10/sol_prog01_10m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! declaration of variables 16 | integer, parameter :: n = 11 17 | real*8, parameter :: gamma = 0.5d0 18 | 19 | contains 20 | 21 | ! subroutine to compute utilities within a certain interval 22 | subroutine utility_int(a_local, b_local, u_local) 23 | 24 | implicit none 25 | 26 | ! input variables 27 | real*8, intent(in) :: a_local, b_local 28 | real*8, intent(out) :: u_local(:) 29 | real*8 :: c_local(size(u_local)) 30 | integer :: n, j 31 | 32 | ! check whether 0 <= a < b: 33 | if(a_local <= 0d0 .or. b_local < a_local)then 34 | stop 'Error: a <= 0 or b < a: subroutine can`t be used' 35 | endif 36 | 37 | ! size of the array u_local 38 | n = size(u_local) 39 | 40 | ! calculation of consumption level and utilities 41 | do j = 1, n 42 | c_local(j) = a_local + dble(j-1)/dble(n-1)*(b_local - a_local) 43 | u_local(j) = utility(c_local(j)) 44 | enddo 45 | 46 | end subroutine 47 | 48 | ! subroutine to compute utility 49 | function utility(c_local) 50 | 51 | implicit none 52 | 53 | ! input variables 54 | real*8, intent(in) :: c_local 55 | real*8 :: utility 56 | 57 | ! check whether c_local <= 0; otherwise print an error message 58 | if(c_local <= 0d0)then 59 | stop 'Error: c_local <= 0 in function utility' 60 | endif 61 | 62 | ! compute utility 63 | utility = c_local**(1d0-1d0/gamma)/(1d0-1d0/gamma) 64 | 65 | end function 66 | 67 | end module 68 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_08/sol_prog08_08m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.975d0 18 | real*8, parameter :: r = 0.02d0 19 | real*8, parameter :: w = 1d0 20 | real*8, parameter :: a0 = 0d0 21 | real*8, parameter :: a_borrow = 5d0 22 | 23 | ! numerical parameters 24 | real*8, parameter :: sig = 1d-6 25 | integer, parameter :: itermax = 2000 26 | 27 | ! time path of consumption and resource 28 | integer, parameter :: TT = 200 29 | real*8 :: c_t(0:TT), a_t(0:TT) 30 | 31 | ! value and policy function 32 | integer, parameter :: NA = 1000 33 | real*8 :: a(0:NA), c(0:NA) 34 | real*8 :: a_l, a_u 35 | 36 | ! variables to numerically determine value and policy function 37 | real*8 :: c_new(0:NA), coeff_c(NA+3) 38 | real*8 :: con_lev, x_in, fret 39 | logical :: check 40 | 41 | ! variables to communicate with function 42 | integer :: ia_com 43 | 44 | contains 45 | 46 | 47 | ! the first order condition 48 | function foc(x_in) 49 | 50 | use toolbox 51 | 52 | ! variable declarations 53 | real*8, intent(in) :: x_in 54 | real*8 :: foc, cplus 55 | 56 | ! calculate future utility 57 | cplus = spline_eval(min(x_in, a_u), coeff_c, a_l, a_u) 58 | 59 | ! extrapolate if p goes beyond a_u 60 | if(x_in > a_u)then 61 | cplus = cplus + (x_in-a_u)*(c(NA)-c(NA-1))/(a(NA)-a(NA-1)) 62 | endif 63 | 64 | ! get utility function 65 | foc = (1d0+r)*a(ia_com) + w - x_in - (beta*(1d0+r))**(-gamma)*cplus 66 | 67 | end function 68 | 69 | end module 70 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_03/prog03_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM market2 3 | ! 4 | ! ## The static GE model with variable labor supply 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog03_03m.f90" 14 | 15 | program market2 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(3), L(2), K(2), Y(2), Ybar, w, r, p(2), U, ell 22 | logical :: check 23 | 24 | ! initial guess 25 | x(:) = 0.5d0 26 | 27 | ! find market equilibrium 28 | call fzero(x, markets, check) 29 | 30 | ! check whether fzero converged 31 | if(check)then 32 | write(*,'(a/)')'Error in fzero !!!' 33 | stop 34 | endif 35 | 36 | ! copy prices 37 | p(1) = 1d0 38 | p(2) = x(1) 39 | w = x(2) 40 | r = x(3) 41 | 42 | ! calculate other economic variables 43 | Ybar = w*Tbar+r*Kbar 44 | Y = alpha*Ybar/p 45 | ell = (1d0-alpha(1)-alpha(2))*Ybar/w 46 | L = beta*p*Y/w 47 | K = (1d0-beta)*p*Y/r 48 | U = Y(1)**alpha(1)*Y(2)**alpha(2)*ell**(1d0-alpha(1)-alpha(2)) 49 | 50 | ! output 51 | write(*,'(/a)')'GOODS MARKET 1 :' 52 | write(*,'(4(a,f6.2,2x))')' X1 =',Y(1),' Y1 =',Y(1) 53 | write(*,'(2(a,f6.2,2x))')' q1 =',p(1),' p1 =',p(1) 54 | 55 | write(*,'(/a)')'GOODS MARKET 2 :' 56 | write(*,'(2(a,f6.2,2x))')' X2 =',Y(2),' Y2 =',Y(2) 57 | write(*,'(2(a,f6.2,2x))')' q2 =',p(2),' p2 =',p(2) 58 | 59 | write(*,'(/a)')'LABOR MARKET :' 60 | write(*,'(3(a,f6.2,2x))')' L1 =',L(1),' L2 =',L(2),' T-F=',Tbar-ell 61 | write(*,'(a,f6.2,2x)')' w =',w 62 | 63 | write(*,'(/a)')'CAPITAL MARKET :' 64 | write(*,'(4(a,f6.2,2x))')' K1 =',K(1),' K2 =',K(2),' K =',Kbar 65 | write(*,'(a,f6.2,2x)')' r =',r 66 | 67 | write(*,'(/a)')'UTILITY :' 68 | write(*,'(a,f6.2,2x)')' U =',U 69 | 70 | end program 71 | 72 | -------------------------------------------------------------------------------- /code-solution/sol_prog04/sol_prog04_12/sol_prog04_12.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM individual_mortality_risk 3 | ! 4 | ! ## Elimination of individual mortality risk 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "sol_prog04_12m.f90" 14 | 15 | program individual_mortality_risk 16 | 17 | use toolbox 18 | use globals 19 | 20 | implicit none 21 | 22 | ! initialize mortality data 23 | call init_data 24 | 25 | ! initialize interval borders 26 | call init_borders 27 | 28 | ! simulate individual mortality 29 | do in = 1, NN 30 | 31 | ! draw random number 32 | call simulate_uniform(rand, 0d0, 1d0) 33 | 34 | ! compute individual payout and averaging over all contracts 35 | ind_LI(in) = get_LI(rand) 36 | agg_LI(in) = (1d0-xi_2)*sum(ind_LI(1:in))/dble(in) 37 | 38 | enddo 39 | 40 | ! write results to the screen 41 | write(*,'(/a, f10.3/)')'Average Cost = ', agg_LI(NN) 42 | 43 | ! set up and execute plot 44 | call plot(dble((/(in, in=1, NN)/)), agg_LI) 45 | call execplot(xlabel='n_i Clients', ylabel='Expected Cost') 46 | 47 | contains 48 | 49 | ! initialize mortality and portfolio data 50 | subroutine init_data() 51 | 52 | implicit none 53 | 54 | !mortality in the base period 0 55 | q(1) = 0.00186d0 56 | q(2) = 0.00222d0 57 | q(3) = 0.00268d0 58 | q(4) = 0.00389d0 59 | q(5) = 0.00632d0 60 | q(6) = 0.01123d0 61 | q(7) = 0.01957d0 62 | q(8) = 0.02987d0 63 | q(9) = 0.04483d0 64 | q(10) = 0.06528d0 65 | q(11) = 0.10007d0 66 | q(12) = 0.17166d0 67 | q(13) = 0.28709d0 68 | q(14) = 0.46296d0 69 | q(15) = 0.66523d0 70 | q(16) = 1.0d0 71 | 72 | end subroutine init_data 73 | 74 | end program 75 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_01/prog02_01.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM matrices 3 | ! 4 | ! ## Operations on matrices 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program matrices 14 | 15 | implicit none 16 | integer :: i, j 17 | real*8 :: a(4), b(4) 18 | real*8 :: x(2, 4), y(4, 2), z(2, 2) 19 | 20 | ! initialize vectors and matrices 21 | a = (/(dble(5-i), i=1, 4)/) 22 | b = a+4d0 23 | x(1, :) = (/1d0, 2d0, 3d0, 4d0/) 24 | x(2, :) = (/5d0, 6d0, 7d0, 8d0/) 25 | y = transpose(x) 26 | z = matmul(x, y) 27 | 28 | ! show results of different functions 29 | write(*,'(a,4f7.1/)')' vector a = ',(a(i), i=1,4) 30 | write(*,'(a,f7.1)') ' sum(a) = ',sum(a) 31 | write(*,'(a,f7.1/)') ' product(a) = ',product(a) 32 | write(*,'(a,f7.1)') ' maxval(a) = ',maxval(a) 33 | write(*,'(a,i7)') ' maxloc(a) = ',maxloc(a) 34 | write(*,'(a,f7.1)') ' minval(a) = ',minval(a) 35 | write(*,'(a,i7/)') ' minloc(a) = ',minloc(a) 36 | write(*,'(a,4f7.1)') ' cshift(a, -1) = ',cshift(a, -1) 37 | write(*,'(a,4f7.1/)')' eoshift(a, -1) = ',eoshift(a, -1) 38 | write(*,'(a,l7)') ' all(a<3d0) = ',all(a < 3d0) 39 | write(*,'(a,l7)') ' any(a<3d0) = ',any(a < 3d0) 40 | write(*,'(a,i7/)') ' count(a<3d0) = ',count(a < 3d0) 41 | write(*,'(a,4f7.1/)')' vector b = ',(b(i), i=1,4) 42 | write(*,'(a,f7.1/)') ' dot_product(a,b) = ',dot_product(a, b) 43 | write(*,'(a,4f7.1/,20x,4f7.1/)') & 44 | ' matrix x = ',((x(i,j), j=1,4), i=1,2) 45 | write(*,'(a,2f7.1,3(/20x,2f7.1)/)')& 46 | ' transpose(x) = ',((y(i,j), j=1,2), i=1,4) 47 | write(*,'(a,2f7.1/,20x,2f7.1/)') & 48 | ' matmul(x,y) = ',((z(i,j), j=1,2), i=1,2) 49 | 50 | end program 51 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_04/sol_prog08_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.975d0 19 | real*8, parameter :: r = 0.02d0 20 | real*8, parameter :: w = 1d0 21 | real*8, parameter :: a0 = 0d0 22 | 23 | ! numerical parameters 24 | real*8, parameter :: sig = 1d-6 25 | integer, parameter :: itermax = 2000 26 | 27 | ! time path of consumption and resource 28 | integer, parameter :: TT = 500 29 | real*8 :: c_t(0:TT), a_t(0:TT) 30 | 31 | ! value and policy function 32 | integer, parameter :: NA = 1000 33 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 34 | real*8 :: a_l, a_u 35 | 36 | ! variables to numerically determine value and policy function 37 | real*8 :: V_new(0:NA), coeff_V(NA+3), coeff_c(NA+3) 38 | real*8 :: con_lev, x_in, fret 39 | 40 | ! variables to communicate with function 41 | integer :: ia_com 42 | 43 | contains 44 | 45 | 46 | ! the functions that should be minimized 47 | function utility(x_in) 48 | 49 | use toolbox 50 | 51 | implicit none 52 | real*8, intent(in) :: x_in 53 | real*8 :: utility, cons, vplus 54 | 55 | ! calculate consumption 56 | cons = (1d0+r)*a(ia_com) + w - x_in 57 | 58 | ! calculate future utility 59 | vplus = max(spline_eval(x_in, coeff_V, a_l, a_u), 1d-10)**egam/egam 60 | 61 | ! get utility function 62 | if(cons < 1d-10)then 63 | utility = -1d-10**egam/egam*(1d0+abs(cons)) 64 | else 65 | utility = - (cons**egam/egam + beta*vplus) 66 | endif 67 | 68 | end function 69 | 70 | end module 71 | -------------------------------------------------------------------------------- /code-book/prog02/prog02_16/prog02_16.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM simulation 3 | ! 4 | ! ## Simulation of realizations of random variables 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program simulation 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer, parameter :: NN = 20000 19 | real*8 :: x(0:NN) 20 | real*8 :: a, b, mu, sigma, alpha, beta, p, q 21 | integer :: n 22 | 23 | ! uniform distribution 24 | a = -1d0 25 | b = 1d0 26 | call simulate_uniform(x, a, b) 27 | call plot_hist(x, 20) 28 | call execplot(title="Uniform Distribution") 29 | 30 | ! normal distribution 31 | mu = 1d0 32 | sigma = 0.25d0 33 | call simulate_normal(x, mu, sigma) 34 | call plot_hist(x, 20, left=mu-3d0*sqrt(sigma), right=mu+3d0*sqrt(sigma)) 35 | call execplot(title="Normal Distribution") 36 | 37 | ! log-normal distribution 38 | mu = 1d0 39 | sigma = 0.25d0 40 | call simulate_log_normal(x, mu, sigma) 41 | call plot_hist(x, 20, left=0d0, right=mu+5d0*sqrt(sigma)) 42 | call execplot(title="Log-Normal Distribution") 43 | 44 | ! Gamma distribution 45 | alpha = 2d0 46 | beta = 1.25d0 47 | call simulate_Gamma(x, alpha, beta) 48 | call plot_hist(x, 20) 49 | call execplot(title="Gamma Distribution") 50 | 51 | ! beta distribution 52 | p = 2d0 53 | q = 5d0 54 | call simulate_beta(x, p, q) 55 | call plot_hist(x, 20) 56 | call execplot(title="beta Distribution") 57 | 58 | ! bernoulli distribution 59 | p = 0.25d0 60 | call simulate_bernoulli(x, p) 61 | call plot_hist(x, 2) 62 | call execplot(title="Bernoulli Distribution") 63 | 64 | ! binomial distribution 65 | p = 0.25d0 66 | n = 12 67 | call simulate_binomial(x, n, p) 68 | call plot_hist(x, n+1, left=-0.5d0, right=dble(n)+0.5d0) 69 | call execplot(title="Binomial Distribution") 70 | 71 | end program 72 | -------------------------------------------------------------------------------- /code-book/prog01/prog01_18/prog01_18.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Plotgraphs3D 3 | ! 4 | ! ## How to plot graphs in 3D using the toolbox 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Plotgraphs3D 14 | 15 | use toolbox 16 | 17 | implicit none 18 | integer, parameter :: nplot1 = 80 19 | integer, parameter :: nplot2 = 50 20 | real*8 :: x(0:nplot1), y(0:nplot2), z(0:nplot1, 0:nplot2) 21 | real*8 :: a(0:nplot1), b(0:nplot1), c(0:nplot1) 22 | integer :: i1, i2 23 | 24 | ! Initialize x values 25 | do i1 = 0, nplot1 26 | x(i1) = -5d0 + 10d0/dble(nplot1)*dble(i1) 27 | enddo 28 | 29 | ! initialize y values 30 | do i2 = 0, nplot2 31 | y(i2) = -3d0 + 6d0/dble(nplot2)*dble(i2) 32 | enddo 33 | 34 | ! get z values 35 | do i1 = 0, nplot1 36 | do i2 = 0, nplot2 37 | z(i1, i2) = sin(x(i1))*cos(y(i2)) 38 | enddo 39 | enddo 40 | 41 | ! call 3D plotting routine 42 | call plot3d(x, y, z) 43 | 44 | ! call 3D plotting routine with complete configuration 45 | call plot3d(x, y, z, color='black', linewidth=0.5d0, marker=2, & 46 | markersize=0.3d0, noline=.false., & 47 | xlim=(/-6d0, 6d0/), xticks=1.0d0, xlabel='x-Axis', & 48 | ylim=(/-3d0, 3d0/), yticks=0.5d0, ylabel='y-Axis', & 49 | zlim=(/-1d0, 1d0/), zticks=0.2d0, zlabel='z-Axis', & 50 | zlevel=0d0, surf=.true., surf_color=2, & 51 | transparent=.true., view=(/70d0, 50d0/), & 52 | title='sin(x)*cos(y)', filename='testplot', & 53 | filetype='eps', output='testdata') 54 | 55 | 56 | ! initialize spiral data 57 | do i1 = 0, nplot1 58 | c(i1) = 20d0*dble(i1)/dble(nplot1) 59 | a(i1) = sin(c(i1)) 60 | b(i1) = cos(c(i1)) 61 | enddo 62 | 63 | ! plot spiral 64 | call plot3d(a, b, c, linewidth=2d0) 65 | 66 | end program 67 | -------------------------------------------------------------------------------- /code-solution/sol_prog08/sol_prog08_07/sol_prog08_07m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.975d0 19 | real*8, parameter :: r = 0.02d0 20 | real*8, parameter :: w = 1d0 21 | real*8, parameter :: a0 = 0d0 22 | real*8, parameter :: a_borrow = 5d0 23 | 24 | ! numerical parameters 25 | real*8, parameter :: sig = 1d-6 26 | integer, parameter :: itermax = 2000 27 | 28 | ! time path of consumption and resource 29 | integer, parameter :: TT = 200 30 | real*8 :: c_t(0:TT), a_t(0:TT) 31 | 32 | ! value and policy function 33 | integer, parameter :: NA = 1000 34 | real*8 :: a(0:NA), c(0:NA), V(0:NA) 35 | real*8 :: a_l, a_u 36 | 37 | ! variables to numerically determine value and policy function 38 | real*8 :: V_new(0:NA), coeff_V(NA+3), coeff_c(NA+3) 39 | real*8 :: con_lev, x_in, fret 40 | 41 | ! variables to communicate with function 42 | integer :: ia_com 43 | 44 | contains 45 | 46 | 47 | ! the function that should be minimized 48 | function utility(x_in) 49 | 50 | use toolbox 51 | 52 | implicit none 53 | real*8, intent(in) :: x_in 54 | real*8 :: utility, cons, vplus 55 | 56 | ! calculate consumption 57 | cons = (1d0+r)*a(ia_com) + w - x_in 58 | 59 | ! calculate future utility 60 | vplus = max(spline_eval(x_in, coeff_V, a_l, a_u), 1d-10)**egam/egam 61 | 62 | ! get utility function 63 | if(cons < 1d-10)then 64 | utility = -1d-10**egam/egam*(1d0+abs(cons)) 65 | else 66 | utility = - (cons**egam/egam + beta*vplus) 67 | endif 68 | 69 | end function 70 | 71 | end module 72 | -------------------------------------------------------------------------------- /code-solution/sol_prog03/sol_prog03_04/sol_prog03_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Tbar = 30d0 16 | real*8, parameter :: alpha = 0.3d0 17 | real*8, parameter :: alphax = 0.5d0 18 | real*8, parameter :: nu = 0.5d0 19 | real*8, parameter :: nux = 0.5d0 20 | real*8, parameter :: mu = 1d0-1d0/nu 21 | real*8, parameter :: mux = 1d0-1d0/nux 22 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 23 | real*8, parameter :: sigma(2) = (/ 0.5d0, 0.5d0/) 24 | real*8, parameter :: rho(2) = 1d0-1d0/sigma 25 | 26 | real*8 :: L(2), K(2), Y(2), ly(2), ky(2) 27 | real*8 :: Ybar, Omega, PP, w, r, p(2), U 28 | real*8 :: YD, C, ell 29 | 30 | contains 31 | 32 | ! function to determine market equilibrium 33 | function markets(x) 34 | 35 | implicit none 36 | real*8, intent(in) :: x 37 | real*8 :: markets 38 | 39 | ! calculate prices 40 | w = 1d0 41 | r = x 42 | ly = (beta + (1d0-beta)*(beta*r/((1d0-beta)*w))**(1d0-sigma))**(-1d0/rho) 43 | ky = ((1d0-beta) + beta*((1d0-beta)*w/(beta*r))**(1d0-sigma))**(-1d0/rho) 44 | p = ly*w + ky*r 45 | PP = alphax*p(1)**(1d0-nux) + (1d0-alphax)*p(2)**(1d0-nux) 46 | Omega = (1d0-alpha)*PP**(1d0-nu) + alpha*w**(1d0-nu) 47 | 48 | ! calculate other economic variables 49 | Ybar = w*Tbar+r*Kbar 50 | C = (1d0-alpha)*Ybar/PP**nu/Omega 51 | ell = alpha*Ybar/w**nu/Omega 52 | YD = Ybar-w*ell 53 | Y(1) = alphax*YD/p(1)**nux/PP 54 | Y(2) = (1d0-alphax)*YD/p(2)**nux/PP 55 | L = ly*Y 56 | K = ky*Y 57 | 58 | ! get market equations 59 | markets = K(1)+K(2)-Kbar 60 | 61 | end function 62 | 63 | end module 64 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_03/sol_prog02_03m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! number of gridpoints to set up intervals 16 | integer, parameter :: n = 4 17 | 18 | ! number of gridpoints for plot 19 | integer, parameter :: n_plot = 100 20 | 21 | ! set lower bound for interval 22 | real*8, parameter :: x_l = 0d0 23 | 24 | ! set upper bound for interval 25 | real*8, parameter :: x_u = 5d0 26 | 27 | ! set tolerance level 28 | real*8, parameter :: tol = 1d-6 29 | 30 | ! variables used to locate the global minimum 31 | real*8 :: x(0:n), minimum_x(n), fmin(n) 32 | real*8 :: xplot(0:n_plot), yplot(0:n_plot) 33 | 34 | contains 35 | 36 | function minimize(a, b) 37 | 38 | implicit none 39 | 40 | ! declaration of variables 41 | real*8, intent(in) :: a 42 | real*8, intent(in) :: b 43 | integer :: iter 44 | real*8 :: minimize 45 | real*8 :: a1, b1, x1, x2, f1, f2 46 | 47 | ! set starting values for the iteration 48 | a1 = a 49 | b1 = b 50 | 51 | ! start iteration process 52 | do iter = 1, 200 53 | 54 | ! calculate x1 and x2 values and function values 55 | x1 = a1 + (3d0-sqrt(5d0))/2d0*(b1-a1) 56 | x2 = a1 + (sqrt(5d0)-1d0)/2d0*(b1-a1) 57 | f1 = x1*cos(x1**2) 58 | f2 = x2*cos(x2**2) 59 | 60 | ! get new values 61 | if(f1 < f2)then 62 | b1 = x2 63 | else 64 | a1 = x1 65 | endif 66 | 67 | if(abs(b1-a1) < tol)exit 68 | 69 | enddo 70 | 71 | ! set return value 72 | if(f1 < f2)then 73 | minimize = x1 74 | else 75 | minimize = x2 76 | endif 77 | 78 | end function 79 | 80 | end module 81 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_08/sol_prog01_08.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM RollDiceEndCondition 3 | ! 4 | ! ## Simulate how long it takes until the game is ended by condition x or y 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program RollDiceEndCondition 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! declaration of variables and parameters 20 | integer, parameter :: n = 2 21 | integer, parameter :: mroll = 250 22 | integer, parameter :: iter = 5000 23 | integer :: i, j, k, dice(n), max_roll, x, y 24 | real*8 :: count_x, SimProb_x 25 | 26 | ! set random seed 27 | call init_random_seed() 28 | 29 | ! simulate dice rolls 30 | x = 4 31 | y = 10 32 | count_x = 0d0 33 | max_roll = 0 34 | do i = 1, iter 35 | do j = 1, mroll 36 | do k = 1, n 37 | call random_int(dice(k), 1, 6) 38 | enddo 39 | 40 | if(sum(dice) == x)then 41 | count_x = count_x + 1d0 42 | max_roll = max(max_roll, j) 43 | exit 44 | elseif(sum(dice) == y)then 45 | max_roll = max(max_roll, j) 46 | exit 47 | endif 48 | enddo 49 | enddo 50 | 51 | SimProb_x = count_x/iter*100d0 52 | 53 | ! print output 54 | write(*,'(a, i4)')'Maximum Number of Rolls:', max_roll 55 | write(*,'(a, f7.2)')'First condition (in %):', SimProb_x 56 | write(*,'(a, f7.2)')'Second condition (in %):', 100d0 - SimProb_x 57 | 58 | contains 59 | 60 | ! simulate a dice roll 61 | subroutine random_int(result, intl, inth) 62 | 63 | implicit none 64 | 65 | ! declaration of variables 66 | integer, intent(in) :: intl, inth 67 | integer, intent(out):: result 68 | real*8 :: x 69 | 70 | ! call fortran intrinsic reandom number generator 71 | call random_number(x) 72 | result = int(inth*x) + intl 73 | 74 | end subroutine 75 | 76 | end program 77 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_04/prog03_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Tbar = 30d0 16 | real*8, parameter :: alpha(2) = (/0.3d0, 0.4d0/) 17 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 18 | real*8, parameter :: G = 3d0 19 | real*8 :: tauw = 0d0 20 | real*8 :: taur = 0.0d0 21 | real*8 :: tauc(2) = 0d0 22 | 23 | contains 24 | 25 | 26 | ! function to determine market equilibrium 27 | function markets(x) 28 | 29 | implicit none 30 | real*8, intent(in) :: x(:) 31 | real*8 :: markets(size(x, 1)) 32 | real*8 :: Ybarn, q(2), p(2), w, wn, r, rn 33 | 34 | ! copy producer prices and taxes 35 | q(1) = 1d0 36 | q(2) = x(1) 37 | w = x(2) 38 | r = x(3) 39 | 40 | ! set tax rates (uncomment respective line for different tables) 41 | taur = x(4) 42 | !tauw = -x(4) 43 | !tauc(1) = x(4) 44 | !tauc(2) = x(4) 45 | 46 | ! calculate consumer prices and total income 47 | p = q*(1d0+tauc) 48 | wn = w*(1d0-tauw) 49 | rn = r*(1d0-taur) 50 | Ybarn = wn*Tbar+rn*Kbar 51 | 52 | ! get market equations 53 | markets(1) = alpha(1)*Ybarn/p(1)+G-(beta(1)/w)**beta(1)* & 54 | ((1d0-beta(1))/r)**(1d0-beta(1))*q(1)*(alpha(1)*Ybarn/p(1)+G) 55 | markets(2) = 1d0/p(2)-(beta(2)/w)**beta(2)* & 56 | ((1d0-beta(2))/r)**(1d0-beta(2))*q(2)/p(2) 57 | markets(3) = beta(1)/w*q(1)*(alpha(1)*Ybarn/p(1)+G)+ & 58 | beta(2)/w*q(2)*alpha(2)*Ybarn/p(2)+(1d0-alpha(1)-alpha(2))*Ybarn/wn-Tbar 59 | markets(4) = q(1)*G-tauc(1)/(1d0+tauc(1))*alpha(1)*Ybarn- & 60 | tauc(2)/(1d0+tauc(2))*alpha(2)*Ybarn-& 61 | tauw*w*(Tbar-(1d0-alpha(1)-alpha(2))/wn*Ybarn)-taur*r*Kbar 62 | 63 | end function 64 | 65 | end module 66 | -------------------------------------------------------------------------------- /code-book/prog09/prog09_02/prog09_02m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: egam = 1d0-1d0/gamma 18 | real*8, parameter :: beta = 0.99d0 19 | real*8, parameter :: alpha = 0.40d0 20 | real*8, parameter :: delta = 0.019d0 21 | 22 | ! government parameters (change accordingly to simulate Table 9.1) 23 | real*8, parameter :: tau_r = 0.00d0 24 | real*8, parameter :: gy = 0.00d0 25 | real*8, parameter :: by = 0.00d0 26 | 27 | ! numerical parameters 28 | real*8, parameter :: k_l = 5d0 29 | real*8, parameter :: k_u = 100d0 30 | real*8, parameter :: sig = 1d-6 31 | integer, parameter :: itermax = 2000 32 | 33 | ! counter variables 34 | integer :: it, ik, iter 35 | 36 | ! government consumption 37 | real*8 :: gbar 38 | 39 | ! time path of consumption and capital 40 | integer, parameter :: TT = 3600 41 | real*8 :: c_t(0:TT), i_t(0:TT), k_t(0:TT), y_t(0:TT), w_t(0:TT), r_t(0:TT) 42 | real*8 :: tauw_t(0:TT), b_t(0:TT) 43 | 44 | ! policy function 45 | integer, parameter :: NK = 100 46 | real*8 :: k(0:NK), c(0:NK) 47 | 48 | ! variables to numerically determine policy function 49 | real*8 :: c_new(0:NK), coeff_c(NK+3) 50 | real*8 :: con_lev, x_in 51 | logical :: check 52 | 53 | ! variables to communicate with function 54 | real*8 :: k_com 55 | 56 | contains 57 | 58 | 59 | ! the first order condition 60 | function foc(x_in) 61 | 62 | use toolbox 63 | 64 | implicit none 65 | real*8, intent(in) :: x_in 66 | real*8 :: foc, kplus, bplus, cplus 67 | 68 | ! future capital 69 | kplus = (1d0-delta)*k_com + k_com**alpha - x_in - gbar 70 | 71 | ! calculate future consumption 72 | cplus = spline_eval(kplus, coeff_c, k_l, k_u) 73 | 74 | ! get first order condition 75 | foc = x_in - (beta*(1d0+(1d0-tau_r)*(alpha*kplus**(alpha-1d0)-delta)))**(-gamma)*cplus 76 | 77 | end function 78 | 79 | end module 80 | -------------------------------------------------------------------------------- /code-book/prog03/prog03_06/prog03_06m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE GLOBALS 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | real*8, parameter :: Kbar = 10d0 15 | real*8, parameter :: Tbar = 30d0 16 | real*8, parameter :: alpha(2) = (/0.3d0, 0.4d0/) 17 | real*8, parameter :: beta(2) = (/ 0.3d0, 0.6d0/) 18 | real*8, parameter :: a0(2) = (/0.2d0, 0.2d0/) 19 | real*8, parameter :: a(2, 2) = reshape((/ 0d0, 0.3d0, 0.2d0, 0d0 /),(/2,2/)) 20 | real*8, parameter :: ID(2, 2) = reshape((/ 1d0, 0d0, 0d0, 1d0 /),(/2,2/)) 21 | real*8, parameter :: G = 3d0 22 | real*8 :: tauw = 0d0 23 | real*8 :: taur = 0d0 24 | real*8 :: tauc(2) = 0d0 25 | real*8 :: Ybarn, q(2), p(2), w, wn, r, rn 26 | real*8 :: Xd(2), Y(2), ky(2), ly(2), K(2), L(2), ell 27 | 28 | contains 29 | 30 | 31 | ! function to determine market equilibrium 32 | function markets(x) 33 | 34 | use toolbox 35 | 36 | implicit none 37 | real*8, intent(in) :: x(:) 38 | real*8 :: markets(size(x, 1)) 39 | 40 | ! copy producer prices and taxes 41 | w = 1d0 42 | r = x(1) 43 | tauc(1) = x(2) 44 | tauc(2) = tauc(1) 45 | 46 | ! 1. calkulate K/Y and L/Y 47 | ky = a0*((1d0-beta)/beta*w/r)**beta 48 | ly = a0*(beta/(1d0-beta)*r/w)**(1d0-beta) 49 | 50 | ! 2. determine producer prices 51 | q = w*ly+r*ky 52 | call lu_solve(ID-transpose(a), q) 53 | 54 | ! 3. consumer prices and demands 55 | p = q*(1d0+tauc) 56 | wn = w*(1d0-tauw) 57 | rn = r*(1d0-taur) 58 | Ybarn = wn*Tbar+rn*Kbar 59 | Xd = alpha/p*Ybarn 60 | ell = (1d0-alpha(1)-alpha(2))/wn*Ybarn 61 | 62 | ! 4. determine output levels 63 | Y(1) = Xd(1)+G 64 | Y(2) = Xd(2) 65 | call lu_solve(ID-a, Y) 66 | 67 | ! 5. compute K and L 68 | K = ky*Y 69 | L = ly*Y 70 | 71 | ! 6. check markets and budget 72 | markets(1) = K(1)+K(2)-Kbar 73 | markets(2) = q(1)*G-sum(tauc*q*Xd)-tauw*w*(Tbar-ell)-taur*r*Kbar 74 | 75 | end function 76 | 77 | end module 78 | -------------------------------------------------------------------------------- /code-book/prog06/prog06_02/prog06_02.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM TR_OLG 3 | ! 4 | ! ## The OLG model with transitional dynamics 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog06_02m.f90" 14 | 15 | program TR_OLG 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | logical :: check 22 | real*8 :: x(2) 23 | integer :: it 24 | 25 | ! set reform values (uncomment respective line for different tables) 26 | tax(1:TT) = 2 ! Table 6.2 27 | !tax(1:TT) = 4 ! Table 6.3 28 | !tax(1:TT) = 3 ! Table 6.4 29 | !tax(1:TT) = 3 ; by(1:TT) = -0.058857d0 ! Table 6.5 30 | !kappa(1:TT) = 0.5d0 ! Table 6.6 31 | !by(1:TT) = 0.0986d0 ! Table 6.7 32 | !n_p(1:TT) = 0.0d0 ! Table 6.8 33 | !n_p(1:TT) = 0.0d0 ; kappa = 0.5d0 ; g = 0d0 ! Table 6.9 34 | 35 | ! get labor supply and pension payments 36 | LL = (2d0+n_p)/(1d0+n_p) 37 | taup = kappa/((2d0+n_p)*(1d0+n_p)) 38 | 39 | ! initialize tax rates 40 | tauc = 0d0 41 | tauw = 0d0 42 | taur = 0d0 43 | 44 | ! initialize assets, LSRA payments and debt holdings 45 | a = 0d0 46 | v = 0d0 47 | BA = 0d0 48 | 49 | ! get initial guess 50 | x(:) = 0.7d0 51 | 52 | ! solve the steady state equation system 53 | call fzero(x, eqns_Initial, check) 54 | 55 | ! check whether the solution is valid 56 | if(check)then 57 | write(*, '(/a/)') '!!! No equilibirium found !!!' 58 | stop 59 | endif 60 | 61 | ! write output 62 | open(20, file='output.out') 63 | call output(0, 20) 64 | 65 | ! initialize transitional values 66 | call get_Transition 67 | 68 | ! write output 69 | do it = 1, TT 70 | call output(it, 20) 71 | enddo 72 | close(20) 73 | 74 | open(21, file='summary.out') 75 | call output_summary(21) 76 | 77 | ! get lsra run 78 | lsra_on = .true. 79 | 80 | ! solve for the transition path 81 | call get_Transition 82 | 83 | ! write output 84 | write(21,*) 85 | call output_summary(21) 86 | close(21) 87 | 88 | end program 89 | -------------------------------------------------------------------------------- /code-book/prog09/prog09_04/prog09_04m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.99d0 18 | real*8, parameter :: alpha = 0.40d0 19 | real*8, parameter :: delta = 0.019d0 20 | real*8, parameter :: k0 = 79d0 21 | real*8, parameter :: rho = 0.95d0 22 | real*8, parameter :: sigma_eps = 0.000049d0 23 | 24 | ! numerical parameters 25 | real*8, parameter :: k_l = 50d0 26 | real*8, parameter :: k_u = 110d0 27 | real*8, parameter :: sig = 1d-6 28 | integer, parameter :: itermax = 2000 29 | 30 | ! counter variables 31 | integer :: it, ik, is, iter 32 | 33 | ! time path of consumption and capital 34 | integer, parameter :: TT = 5000 35 | real*8 :: c_t(0:TT), k_t(0:TT), eta_t(0:TT) 36 | integer :: is_t(0:TT) 37 | 38 | ! the shock process 39 | integer, parameter :: NS = 21 40 | real*8 :: pi(NS, NS), eta(NS) 41 | 42 | ! policy function 43 | integer, parameter :: NK = 100 44 | real*8 :: k(0:NK), c(0:NK, NS) 45 | 46 | ! variables to numerically determine policy function 47 | real*8 :: c_new(0:NK, NS), coeff_c(NK+3, NS) 48 | real*8 :: RHS(0:NK, NS), coeff_r(NK+3, NS) 49 | real*8 :: con_lev, x_in 50 | logical :: check 51 | 52 | ! variables to communicate with function 53 | real*8 :: k_com 54 | integer :: is_com 55 | 56 | contains 57 | 58 | 59 | ! the first order condition 60 | function foc(x_in) 61 | 62 | use toolbox 63 | 64 | implicit none 65 | real*8, intent(in) :: x_in 66 | real*8 :: foc, kplus 67 | 68 | ! future capital stock 69 | kplus = (1d0-delta)*k_com + exp(eta(is_com))*k_com**alpha - x_in 70 | 71 | ! calculate future expected marginal utility 72 | foc = spline_eval(min(kplus, k_u), coeff_r(:, is_com), k_l, k_u) 73 | if(kplus > k_u)then 74 | foc = foc + (RHS(NK,is_com)-RHS(NK-1,is_com))/(k(NK)-k(NK-1))*(kplus-k_u) 75 | endif 76 | 77 | ! get first order condition 78 | foc = x_in - foc 79 | 80 | end function 81 | 82 | end module 83 | -------------------------------------------------------------------------------- /code-solution/sol_prog01/sol_prog01_06/sol_prog01_06.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Fibonacci 3 | ! 4 | ! ## Compute the n-th element of the Fibonacci-Series 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Fibonacci 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! declaration of parameters 20 | integer, parameter :: plotmax = 100 21 | integer :: n, i 22 | real*8 :: x(1:plotmax), diff(1:plotmax) 23 | 24 | ! read input 25 | write(*,'(a)')'Type in the requested element of series: ' 26 | read(*,*)n 27 | 28 | ! print outut 29 | write(*,'(i3,a)') n, '-element of the Fibonacci series (with do-loops): ' 30 | write(*,'(f40.12)') fib(n) 31 | write(*,'(i3,a)') n, '-element of the Fibonacci series (with Binets formula): ' 32 | write(*,'(f40.12)') Binform(n) 33 | 34 | ! plot the difference between iterative solution Binet's-formula 35 | do i = 1, plotmax 36 | x(i) = i 37 | diff(i) = abs(fib(i) - Binform(i)) 38 | enddo 39 | 40 | call plot(x, diff, legend='Diff') 41 | call execplot() 42 | 43 | contains 44 | 45 | ! iterative solution 46 | function fib(n) 47 | 48 | implicit none 49 | 50 | ! input variables 51 | integer, intent(in):: n 52 | integer:: j 53 | real*8 :: a0, a1, a2, fib 54 | 55 | ! Calculation of the result 56 | if(n <= 2)then 57 | a0 = 1 58 | else 59 | 60 | ! initialize the first two elements 61 | a1 = 1 62 | a2 = 1 63 | 64 | ! calculate the n-th element 65 | do j = 3, n 66 | a0 = a1 + a2 67 | a2 = a1 68 | a1 = a0 69 | enddo 70 | endif 71 | 72 | fib = a0 73 | 74 | end function 75 | 76 | ! closed-form solution 77 | function Binform(n) 78 | 79 | implicit none 80 | 81 | ! input variables 82 | integer, intent(in):: n 83 | real*8:: Binform 84 | real*8:: golden_ratio 85 | 86 | golden_ratio = (1d0 + sqrt(5d0))/2d0 87 | 88 | Binform = (golden_ratio**(n) - (1d0 - golden_ratio)**(n))/sqrt(5d0) 89 | 90 | end function 91 | 92 | end program 93 | -------------------------------------------------------------------------------- /code-book/prog05/prog05_03/prog05_03.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM household3 3 | ! 4 | ! ## The life cycle model with wage and interest rate risk 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog05_03m.f90" 14 | 15 | program household3 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(1+n_w*n_R) 22 | real*8 :: fret, low(1+n_w*n_R), up(1+n_w*n_R) 23 | integer :: j, iw, ir2, ir3, ic 24 | 25 | ! discretize w 26 | call log_normal_discrete(w, weight_w, mu_w, sig_w) 27 | 28 | ! discretize R 29 | call log_normal_discrete(R, weight_R, mu_R, sig_R) 30 | 31 | ! lower and upper border and initial guess 32 | low = 0d0 33 | up(1) = mu_w 34 | ic = 2 35 | do iw = 1, n_w 36 | do ir2 = 1, n_R 37 | up(ic) = R(ir2)*mu_w+w(iw) 38 | ic = ic+1 39 | enddo 40 | enddo 41 | x = up/2d0 42 | 43 | ! minimization routine 44 | call fminsearch(x, fret, low, up, utility) 45 | 46 | ! set up data for output 47 | do iw = 1, n_w 48 | do ir2 = 1, n_R 49 | do ir3 = 1, n_R 50 | wag(1,iw,ir2,ir3) = mu_w 51 | inc(1,iw,ir2,ir3) = mu_w 52 | sav(1,iw,ir2,ir3) = a(2,1,1) 53 | 54 | wag(2,iw,ir2,ir3) = w(iw) 55 | inc(2,iw,ir2,ir3) = w(iw)+R(ir2)*a(2,1,1) 56 | sav(2,iw,ir2,ir3) = a(3,iw,ir2) 57 | 58 | wag(3,iw,ir2,ir3) = 0d0 59 | inc(3,iw,ir2,ir3) = R(ir3)*a(3,iw,ir2) 60 | sav(3,iw,ir2,ir3) = 0d0 61 | enddo 62 | enddo 63 | enddo 64 | 65 | ! output 66 | write(*,'(/a/)')' AGE CONS WAGE INC SAV' 67 | do j = 1, 3 68 | write(*,'(i4,4f7.2,a)')j,E(c(j,:,:,:)),E(wag(j,:,:,:)),& 69 | E(inc(j,:,:,:)),E(sav(j,:,:,:)),' (MEAN)' 70 | write(*,'(4x,4f7.2,a/)')Std(c(j,:,:,:)),Std(wag(j,:,:,:)),& 71 | Std(inc(j,:,:,:)),Std(sav(j,:,:,:)),' (STD)' 72 | enddo 73 | 74 | write(*,'(/2(a,f6.2))')' E(w) = ',sum(weight_w*w),' Var(w) = ', & 75 | sum(weight_w*w**2)-sum(weight_w*w)**2 76 | write(*,'(2(a,f6.2))')' E(R) = ',sum(weight_R*R),' Var(R) = ', & 77 | sum(weight_R*R**2)-sum(weight_R*R)**2 78 | 79 | end program 80 | -------------------------------------------------------------------------------- /code-solution/sol_prog02/sol_prog02_11/sol_prog02_11.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM Transport 3 | ! 4 | ! ## Use simplex algorithm to minimize the total cost of transportation 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | program Transport 14 | 15 | use toolbox 16 | 17 | implicit none 18 | 19 | ! number of gravel-pits 20 | integer, parameter :: n = 3 21 | 22 | ! number of building sites 23 | integer, parameter :: m = 4 24 | 25 | ! declaration of variables 26 | real*8 :: c(n*m), x(n*m) 27 | real*8 :: A(n+m, n*m), b(n+m) 28 | 29 | ! set up transportation costs 30 | c(:) = (/10d0, 70d0, 100d0, 80d0, & ! gravel-pit 1 31 | 130d0, 90d0, 120d0, 110d0, & ! gravel-pit 2 32 | 50d0, 30d0, 80d0, 10d0/) ! gravel-pit 3 33 | 34 | ! set up matrix for restriction 35 | A(1, :) = (/1d0, 1d0, 1d0, 1d0, 0d0, 0d0, 0d0, 0d0, 0d0, 0d0, 0d0, 0d0/) ! gravel-pit 1 36 | A(2, :) = (/0d0, 0d0, 0d0, 0d0, 1d0, 1d0, 1d0, 1d0, 0d0, 0d0, 0d0, 0d0/) ! gravel-pit 2 37 | A(3, :) = (/0d0, 0d0, 0d0, 0d0, 0d0, 0d0, 0d0, 0d0, 1d0, 1d0, 1d0, 1d0/) ! gravel-pit 3 38 | A(4, :) = (/1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0/) ! building site 1 39 | A(5, :) = (/0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0/) ! building site 2 40 | A(6, :) = (/0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0/) ! building site 3 41 | A(7, :) = (/0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0/) ! building site 4 42 | 43 | ! set up target vector for restriction 44 | b(:) = (/11d0, 13d0, 10d0, 5d0, 7d0, 13d0, 6d0/) 45 | 46 | ! solve the linear problem 47 | call solve_lin(x, c, A, b, 3, 0, 4) 48 | 49 | ! print output 50 | write(*,'(a)')'building site : 1 2 3 4 Sum costs' 51 | write(*,'(a,4f5.1,2f10.1)')'gravel-pit 1 :', x(1:4), sum(x(1:4)), sum(x(1:4)*c(1:4)) 52 | write(*,'(a,4f5.1,2f10.1)')'gravel-pit 2 :', x(5:8), sum(x(5:8)), sum(x(5:8)*c(5:8)) 53 | write(*,'(a,4f5.1,2f10.1)')'gravel-pit 1 :', x(9:12), sum(x(9:12)), sum(x(9:12)*c(9:12)) 54 | write(*,'(a,4f5.1,2f10.1)')'Sum :', x(1) + x(5) + x(9), x(2) + x(6) + x(10), & 55 | x(3) + x(7) + x(11), x(4) + x(8) + x(12), sum(x), sum(x*c) 56 | 57 | end program 58 | -------------------------------------------------------------------------------- /code-solution/sol_prog09/sol_prog09_03/sol_prog09_03m.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! MODULE globals 3 | ! 4 | ! This code is published under the GNU General Public License v3 5 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 6 | ! 7 | ! Authors: Hans Fehr, Maurice Hofmann and Fabian Kindermann 8 | ! contact@ce-fortran.com 9 | ! 10 | !############################################################################## 11 | module globals 12 | 13 | implicit none 14 | 15 | ! model parameters 16 | real*8, parameter :: gamma = 0.5d0 17 | real*8, parameter :: beta = 0.99d0 18 | real*8, parameter :: alpha_c = 0.5d0 19 | real*8, parameter :: alpha_i = 0.5d0 20 | real*8, parameter :: delta = 0.075d0 21 | real*8, parameter :: k0 = 10d0 22 | 23 | ! numerical parameters 24 | real*8, parameter :: k_l = 5d0 25 | real*8, parameter :: k_u = 100d0 26 | real*8, parameter :: sig = 1d-6 27 | integer, parameter :: itermax = 2000 28 | 29 | ! counter variables 30 | integer :: it, ik, iter 31 | 32 | ! time path of consumption and capital 33 | integer, parameter :: TT = 360 34 | real*8 :: c_t(0:TT), i_t(0:TT), k_t(0:TT), kc_t(0:TT), ki_t(0:TT) 35 | 36 | ! policy function 37 | integer, parameter :: NK = 100 38 | real*8 :: k(0:NK), kc(0:NK) 39 | 40 | ! variables to numerically determine policy function 41 | real*8 :: kc_new(0:NK), coeff_kc(NK+3) 42 | real*8 :: con_lev, x_in 43 | logical :: check 44 | 45 | ! variables to communicate with function 46 | real*8 :: k_com 47 | 48 | contains 49 | 50 | 51 | ! the first order condition 52 | function foc(x_in) 53 | 54 | use toolbox 55 | 56 | implicit none 57 | real*8, intent(in) :: x_in 58 | real*8 :: foc, kplus, kcplus, kc 59 | 60 | ! limit current consumption capital 61 | kc = max(x_in, 1d-10) 62 | kc = min(kc, k_com - 1d-10) 63 | 64 | ! future capital 65 | kplus = (1d0-delta)*k_com + (k_com-kc)**alpha_i 66 | 67 | ! calculate future consumption 68 | kcplus = spline_eval(kplus, coeff_kc, k_l, k_u) 69 | kcplus = max(kcplus, 1d-10) 70 | kcplus = min(kcplus, kplus - 1d-10) 71 | 72 | ! get first order condition 73 | foc = kc - (beta*(1d0-delta+alpha_i*(kplus - kcplus) & 74 | **(alpha_i-1d0))*(kc/kcplus)**(1d0-alpha_c) & 75 | *((kplus - kcplus)/(k_com - kc))**(1d0-alpha_i)) & 76 | **(-gamma/alpha_c)*kcplus 77 | 78 | end function 79 | 80 | end module 81 | -------------------------------------------------------------------------------- /code-book/prog05/prog05_05/prog05_05.f90: -------------------------------------------------------------------------------- 1 | !############################################################################## 2 | ! PROGRAM household5 3 | ! 4 | ! ## The life cycle model with annuity choice 5 | ! 6 | ! This code is published under the GNU General Public License v3 7 | ! (https://www.gnu.org/licenses/gpl-3.0.en.html) 8 | ! 9 | ! Authors: Hans Fehr and Fabian Kindermann 10 | ! contact@ce-fortran.com 11 | ! 12 | !############################################################################## 13 | include "prog05_05m.f90" 14 | 15 | program household5 16 | 17 | use globals 18 | use toolbox 19 | 20 | implicit none 21 | real*8 :: x(2*(1+n_w)) 22 | real*8 :: fret, low(2*(1+n_w)), up(2*(1+n_w)) 23 | integer :: j, iw, ic 24 | 25 | ! set tolerance level of minimization routine 26 | call settol_min(1d-14) 27 | 28 | ! discretize log(wage) 29 | call log_normal_discrete(w, weight_w, mu_w, sig_w) 30 | 31 | ! calculate annuity factors 32 | p_a(1) = psi(2)/R+psi(2)*psi(3)/R**2 33 | p_a(2) = psi(3)/R 34 | 35 | ! lower and upper border and initial guess 36 | low(1) = a_lower 37 | up(1) = mu_w 38 | low(2) = 0d0 39 | up(2) = 1d0 40 | ic = 3 41 | do iw = 1, n_w 42 | low(ic) = a_lower 43 | up(ic) = R*mu_w+w(iw) 44 | low(ic+1) = 0d0 45 | up(ic+1) = 1d0 46 | ic = ic+2 47 | enddo 48 | x = 0.5d0 49 | 50 | ! minimization routine 51 | call fminsearch(x, fret, low, up, utility) 52 | 53 | ! set up data for output 54 | do iw = 1, n_w 55 | wag(1,iw) = mu_w 56 | inc(1,iw) = mu_w 57 | sav(1,iw) = a(2,1)*(1d0-omega(1,1)) 58 | alp(1,iw) = a(2,1)*omega(1,1) 59 | 60 | wag(2,iw) = w(iw) 61 | inc(2,iw) = w(iw)+R*(1d0-omega(1,1))*a(2,1)+ & 62 | omega(1,1)*a(2,1)/p_a(1) 63 | sav(2,iw) = a(3,iw)*(1d0-omega(2,iw)) 64 | alp(2,iw) = a(3,iw)*omega(2,iw) 65 | 66 | wag(3,iw) = 0d0 67 | inc(3,iw) = R*(1d0-omega(2,iw))*a(3,iw) + omega(2,iw)*a(3,iw)/p_a(2)+ & 68 | omega(1,1)*a(2,1)/p_a(1)+pen 69 | sav(3,iw) = 0d0 70 | alp(3,iw) = 0d0 71 | enddo 72 | 73 | ! output 74 | write(*,'(/a/)')' AGE CONS WAGE INC SREG SANN' 75 | do j = 1, 3 76 | write(*,'(i4,5f7.2,a)')j,E(c(j,:)),E(wag(j,:)),& 77 | E(inc(j,:)),E(sav(j,:)),E(alp(j,:)),' (MEAN)' 78 | write(*,'(4x,5f7.2,a/)')Std(c(j,:)),Std(wag(j,:)),& 79 | Std(inc(j,:)),Std(sav(j,:)),Std(alp(j,:)),' (STD)' 80 | enddo 81 | 82 | write(*,'(/2(a,f6.2))')' E(w) = ',sum(weight_w*w),' Var(w) = ', & 83 | sum(weight_w*w**2)-sum(weight_w*w)**2 84 | 85 | end program 86 | --------------------------------------------------------------------------------