8.1.1

MODULE Junk
    IMPLICIT NONE
    INTEGER, PARAMETER :: maxlength = 100
    CHARACTER(LEN=*),PARAMETER :: message = 'Kilroy was here'
    INTEGER, SAVE :: errors = 0
    REAL, ALLOCATABLE, DIMENSION(:) :: totals
END MODULE Junk

8.1.2

PROGRAM Futile
    USE JUNK
    IMPLICIT NONE
    INTEGER :: size, err
    Print *, 'Type an integer'
    READ *, size
    IF (size <= 0 .OR. size > maxlength) THEN
        PRINT *, 'Bad size: ', size
        STOP
    END IF
    ALLOCATE(totals(size), STAT=err)
    PRINT *, err
    PRINT *, message
END PROGRAM Futile

output

$a.out
 Type an integer
0
 Bad size:  0
$a.out
 Type an integer
1
 0
 Kilroy was here
$a.out
 Type an integer
100
 0
 Kilroy was here
$a.out
 Type an integer
101
 Bad size:  101

8.1.3

MODULE Junk
    IMPLICIT NONE
    INTEGER, PARAMETER :: maxlength = 100
    CHARACTER(LEN=*),PARAMETER :: message = 'Kilroy was here'
    INTEGER, SAVE :: errors = 0
    REAL, ALLOCATABLE, DIMENSION(:) :: totals
CONTAINS
    SUBROUTINE Rubbish
        PRINT *, SIZE(totals)
    END SUBROUTINE Rubbish
END MODULE Junk

PROGRAM Futile
    USE JUNK
    IMPLICIT NONE
    INTEGER :: size, err
    Print *, 'Type an integer'
    READ *, size
    IF (size <= 0 .OR. size > maxlength) THEN
        PRINT *, 'Bad size: ', size
        STOP
    END IF
    ALLOCATE(totals(size), STAT=err)
    PRINT *, err
    PRINT *, message
    CALL Rubbish
END PROGRAM Futile

output:
 Type an integer
42
           0
 Kilroy was here
          42

8.2.1

MODULE Summer
    IMPLICIT NONE
    REAL, SAVE :: fred = 0.0, joe = 0.0, bill = 0.0
CONTAINS
    SUBROUTINE A
        IMPLICIT NONE
        fred = fred+1.23
    END SUBROUTINE A
    SUBROUTINE B
        IMPLICIT NONE
        joe = fred+0.7
    END SUBROUTINE B
    SUBROUTINE C
        IMPLICIT NONE
        bill = fred+joe
    END SUBROUTINE C
    SUBROUTINE D
        IMPLICIT NONE
        PRINT *, bill
    END SUBROUTINE D
END MODULE Summer

8.2.2

PROGRAM Main
    USE Summer
    IMPLICIT NONE
    CALL A
    CALL B
    CALL A
    CALL B
    CALL A
    CALL A
    CALL C
    CALL D
END PROGRAM Main

output:
   8.0799999

8.2.3

MODULE Summer
    IMPLICIT NONE
    REAL, SAVE, PRIVATE :: fred = 0.0, joe = 0.0, bill = 0.0
CONTAINS
    SUBROUTINE A
        IMPLICIT NONE
        fred = fred+1.23
    END SUBROUTINE A
    SUBROUTINE B
        IMPLICIT NONE
        joe = fred+0.7
    END SUBROUTINE B
    SUBROUTINE C
        IMPLICIT NONE
        bill = fred+joe
    END SUBROUTINE C
    SUBROUTINE D
        IMPLICIT NONE
        PRINT *, bill
    END SUBROUTINE D
END MODULE Summer

output:
   8.0799999

8.2.4

MODULE Summer
    IMPLICIT NONE
    REAL, SAVE :: fred = 0.0, joe = 0.0, bill = 0.0
END MODULE Summer

MODULE Summer_A
CONTAINS
    SUBROUTINE A
        USE Summer, ONLY : fred
        IMPLICIT NONE
        fred = fred+1.23
    END SUBROUTINE A
END MODULE Summer_A

MODULE Summer_B
CONTAINS
    SUBROUTINE B
        USE Summer, ONLY : fred, joe
        IMPLICIT NONE
        joe = fred+0.7
    END SUBROUTINE B
END MODULE Summer_B

MODULE Summer_C
CONTAINS
    SUBROUTINE C
        USE Summer, ONLY : fred, joe, bill
        IMPLICIT NONE
        bill = fred+joe
    END SUBROUTINE C
END MODULE Summer_C

MODULE Summer_D
CONTAINS
    SUBROUTINE D
        USE Summer, ONLY : bill
        IMPLICIT NONE
        PRINT *, bill
    END SUBROUTINE D
END MODULE Summer_D

8.2.5

PROGRAM Main
    USE Summer_A
    USE Summer_B
    USE Summer_C
    USE Summer_D
    IMPLICIT NONE
    CALL A
    CALL B
    CALL A
    CALL B
    CALL A
    CALL A
    CALL C
    CALL D
END PROGRAM Main

output:
   8.0799999

8.3.1

FUNCTION value (arg, targ)
    USE double
    IMPLICIT NONE
    REAL(KIND=DP) :: value, arg, targ
    value = arg**3-targ
END FUNCTION value

FUNCTION derivative (arg)
    USE double
    IMPLICIT NONE
    REAL(KIND=DP) :: derivative, arg
    derivative = 3*arg**2
END FUNCTION derivative

8.3.2

    PROGRAM Newton
        USE double
        IMPLICIT NONE
        INTERFACE
            FUNCTION value (arg, targ)
                USE double
                IMPLICIT NONE
                REAL(KIND=DP) :: value, arg, targ
            END FUNCTION value
            FUNCTION derivative (arg)
                USE double
                IMPLICIT NONE
                REAL(KIND=DP) :: derivative, arg
            END FUNCTION derivative
        END INTERFACE
        REAL(KIND=DP) :: target, current
        REAL(KIND=DP), DIMENSION(5) :: previous
        INTEGER :: i, k
mainloop:   DO
            PRINT *, 'Type in a real number'
            READ (*, *, IOSTAT=k) target
            IF (k < 0) THEN
                STOP
            ELSE IF (k > 0) THEN
                PRINT *, 'Some sort of horrible I/O error'
                STOP
            END IF
            IF (target .EQ. 0.0_DP) THEN
                PRINT *, 'The cube root of zero is, er, zero'
                CYCLE
            END IF
!
! This is cheating, but the hardest part of Newton-Raphson solution of
! Nth roots is getting the starting value, and doing so properly would
! merely be confusing.  So use a horrible hack to get an approximation.
!
            current = 1.1*CMPLX(target,KIND=KIND(0.0))**0.3
            DO i = 1,5
                previous(i) = 0.0_DP
            END DO
loop:       DO
                current = current - &

                    value(current,target)/derivative(current)
                PRINT *, current
                DO i = 1,5
                    if (current .EQ. previous(i)) EXIT loop
                END DO
                DO i = 1,4
                    previous(i+1) = previous(i)
                END DO
                previous(1) = current
            END DO loop
            PRINT *, current**3, current**3.0_DP
        END DO mainloop
    END PROGRAM Newton

output:

 Type in a real number
1.23
   1.0795850679102725
   1.0715025475716751
   1.0714412731951111
   1.0714412696907731
   1.0714412696907731
   1.2300000000000000   1.2300000000000000
 Type in a real number
4.56
   1.6615392639846105
   1.6582753012424118
   1.6582688683948941
   1.6582688683699394
   1.6582688683699394
   4.5599999999999996   4.5599999999999996
 Type in a real number
-3
  -0.6380672516545566
  -2.8815971836389327
  -2.0414944484631032
  -1.6009368177339121
  -1.4574591827210368
  -1.4424077411895482
  -1.4422495876514039
  -1.4422495703074085
  -1.4422495703074083
  -1.4422495703074083
  -3.0000000000000000  -3.0000000000000000

8.4.1

MODULE Lapack

CONTAINS

SUBROUTINE CHOLESKY(A)
    USE double
    IMPLICIT NONE
    INTEGER :: J, N
    REAL(KIND=dp) :: A(:, :), X
    N = UBOUND(A,1)
    DO J = 1, N
        X = SQRT(A(J,J)-DOT_PRODUCT(A(J, :J-1), A(J, :J-1)))
        A(J,J) = X
        IF (J < N) &
            A(J+1:, J) = (A(J+1:, J) - &
                MATMUL(A(J+1:, :J-1), A(J,: J-1))) / X
    END DO
END SUBROUTINE CHOLESKY

END MODULE Lapack

8.4.2

PROGRAM MAIN
    USE double
    USE Lapack
    IMPLICIT NONE
    REAL(KIND=dp), DIMENSION(5, 5) :: A = 0.0_dp
    REAL(KIND=dp), DIMENSION(5) :: Z
    INTEGER :: I, N
    DO N = 1,10
        CALL RANDOM_NUMBER(Z)
        DO I = 1,5
            A(:, I) = A(:, I) + Z*Z(I)
        END DO
    END DO
    WRITE (*,'(5(1X,5F10.6/))') A
    CALL CHOLESKY(A)
    DO I = 1,5
        A(:I-1,I) = 0.0
    END DO
    WRITE (*, '(5(1X,5F10.6/))') A
    WRITE (*, '(5(1X,5F10.6/))') MATMUL(A, TRANSPOSE(A))
END PROGRAM MAIN

output:
   3.620427  1.598773  2.385150  2.703906  2.411213
   1.598773  1.375308  1.554097  1.768143  1.591276
   2.385150  1.554097  3.389675  3.078744  2.570926
   2.703906  1.768143  3.078744  3.722440  2.856250
   2.411213  1.591276  2.570926  2.856250  3.032369

   1.902742  0.840247  1.253533  1.421058  1.267231
   0.000000  0.818104  0.612172  0.701749  0.643548
   0.000000  0.000000  1.201489  0.722279  0.489766
   0.000000  0.000000  0.000000  0.829998  0.301307
   0.000000  0.000000  0.000000  0.000000  0.825642

   3.620427  1.598773  2.385150  2.703906  2.411213
   1.598773  1.375308  1.554097  1.768143  1.591276
   2.385150  1.554097  3.389675  3.078744  2.570926
   2.703906  1.768143  3.078744  3.722440  2.856250
   2.411213  1.591276  2.570926  2.856250  3.032369

8.4.3

PROGRAM MAIN
    USE Lapack
    IMPLICIT NONE
    REAL(KIND=dp), DIMENSION(5, 5) :: A = 0.0_dp
    REAL(KIND=dp), DIMENSION(5) :: Z
    INTEGER :: I, N
    DO N = 1,10
        CALL RANDOM_NUMBER(Z)
        DO I = 1,5
            A(:, I) = A(:, I) + Z*Z(I)
        END DO
    END DO
    WRITE (*,'(5(1X,5F10.6/))') A
    CALL CHOLESKY(A)
    DO I = 1,5
        A(:I-1,I) = 0.0
    END DO
    WRITE (*, '(5(1X,5F10.6/))') A
    WRITE (*, '(5(1X,5F10.6/))') MATMUL(A, TRANSPOSE(A))
END PROGRAM MAIN

It fails to compile because DP is used but not declared, and is not
exported via module LAPACK.

NAG Fortran Compiler Release 5.2(668)
Warning: ex_08.4.3.f90: File ex_08.4.1.f90 containing module LAPACK needs recompilation
Error: ex_08.4.3.f90, line 4: Implicit type for DP
       detected at DP@)
Error: ex_08.4.3.f90, line 4: DP is not a constant
       detected at _@DP
Warning: ex_08.4.3.f90, line 20: Symbol DP referenced but never set
         detected at MAIN@<end-of-statement>
[NAG Fortran Compiler pass 1 error termination, 2 errors, 2 warnings]

8.4.4

MODULE Lapack
    USE double

CONTAINS

SUBROUTINE CHOLESKY(A)
    IMPLICIT NONE
    INTEGER :: J, N
    REAL(KIND=dp) :: A(:, :), X
    N = UBOUND(A,1)
    DO J = 1, N
        X = SQRT(A(J,J)-DOT_PRODUCT(A(J, :J-1), A(J, :J-1)))
        A(J,J) = X
        IF (J < N) &
            A(J+1:, J) = (A(J+1:, J) - &
                MATMUL(A(J+1:, :J-1), A(J,: J-1))) / X
    END DO
END SUBROUTINE CHOLESKY

END MODULE Lapack

output:
   3.232926  2.499079  3.268449  2.500242  2.715818
   2.499079  3.855710  3.154312  3.219439  3.282814
   3.268449  3.154312  4.549182  3.671352  3.002520
   2.500242  3.219439  3.671352  4.129090  2.924040
   2.715818  3.282814  3.002520  2.924040  3.495369

   1.798034  1.389895  1.817790  1.390542  1.510437
   0.000000  1.387048  0.452598  0.927676  0.853226
   0.000000  0.000000  1.019792  0.709727 -0.126796
   0.000000  0.000000  0.000000  0.911694  0.134021
   0.000000  0.000000  0.000000  0.000000  0.672246

   3.232926  2.499079  3.268449  2.500242  2.715818
   2.499079  3.855710  3.154312  3.219439  3.282814
   3.268449  3.154312  4.549182  3.671352  3.002520
   2.500242  3.219439  3.671352  4.129090  2.924040
   2.715818  3.282814  3.002520  2.924040  3.495369

8.4.5

PROGRAM MAIN
    USE double
    USE Lapack
    IMPLICIT NONE
    REAL(KIND=dp), DIMENSION(5, 5) :: A = 0.0_dp
    REAL(KIND=dp), DIMENSION(5) :: Z
    INTEGER :: I, N
    DO N = 1,10
        CALL RANDOM_NUMBER(Z)
        DO I = 1,5
            A(:, I) = A(:, I) + Z*Z(I)
        END DO
    END DO
    WRITE (*,'(5(1X,5F10.6/))') A
    CALL CHOLESKY(A)
    DO I = 1,5
        A(:I-1,I) = 0.0
    END DO
    WRITE (*, '(5(1X,5F10.6/))') A
    WRITE (*, '(5(1X,5F10.6/))') MATMUL(A, TRANSPOSE(A))
END PROGRAM MAIN

output:
   2.495265  2.219417  2.692900  1.932997  3.518723
   2.219417  2.516153  2.815749  1.554389  2.809467
   2.692900  2.815749  3.785698  2.100801  3.785142
   1.932997  1.554389  2.100801  2.790520  3.312570
   3.518723  2.809467  3.785142  3.312570  5.741149

   1.579641  1.405014  1.704755  1.223694  2.227546
   0.000000  0.736267  0.571187 -0.223992 -0.434985
   0.000000  0.000000  0.743812  0.191775  0.317528
   0.000000  0.000000  0.000000  1.098245  0.390084
   0.000000  0.000000  0.000000  0.000000  0.580504

   2.495265  2.219417  2.692900  1.932997  3.518723
   2.219417  2.516153  2.815749  1.554389  2.809467
   2.692900  2.815749  3.785698  2.100801  3.785142
   1.932997  1.554389  2.100801  2.790520  3.312570
   3.518723  2.809467  3.785142  3.312570  5.741149

8.4.6

MODULE Lapack
    INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(12)

CONTAINS

SUBROUTINE CHOLESKY(A)
    IMPLICIT NONE
    INTEGER :: J, N
    REAL(KIND=dp) :: A(:, :), X
    N = UBOUND(A,1)
    DO J = 1, N
        X = SQRT(A(J,J)-DOT_PRODUCT(A(J, :J-1), A(J, :J-1)))
        A(J,J) = X
        IF (J < N) &
            A(J+1:, J) = (A(J+1:, J) - &
                MATMUL(A(J+1:, :J-1), A(J,: J-1))) / X
    END DO
END SUBROUTINE CHOLESKY

END MODULE Lapack

The symbol DP is imported in two USE statements, which is not allowed
because it is ambiguous, and so the compiler uses neither - which
causes later errors.  Not all compilers will do the same following
the first error (double import), and so later messages will vary.

NAG Fortran Compiler Release 5.2(668)
Error: ex_08.4.5.f90, line 5: Symbol DP found both in module DOUBLE and in LAPACK
       detected at =@DP
Error: ex_08.4.5.f90, line 5: Implicit type for DP
       detected at DP@)
Error: ex_08.4.5.f90, line 5: DP is not a constant
       detected at _@DP
Warning: ex_08.4.5.f90, line 21: Symbol DP referenced but never set
         detected at MAIN@<end-of-statement>
[NAG Fortran Compiler pass 1 error termination, 3 errors, 1 warning]

8.5.1

MODULE Lapack
    USE double
    PRIVATE :: dp

CONTAINS

SUBROUTINE CHOLESKY(A)
    IMPLICIT NONE
    INTEGER :: J, N
    REAL(KIND=dp) :: A(:, :), X
    N = UBOUND(A,1)
    DO J = 1, N
        X = SQRT(A(J,J)-DOT_PRODUCT(A(J, :J-1), A(J, :J-1)))
        A(J,J) = X
        IF (J < N) &
            A(J+1:, J) = (A(J+1:, J) - &
                MATMUL(A(J+1:, :J-1), A(J,: J-1))) / X
    END DO
END SUBROUTINE CHOLESKY

END MODULE Lapack

Since DP is not PRIVATE, it is available for use by the module procedure
but is not exported together with the interface of that procedure, and
so it is not declared in the main program.

NAG Fortran Compiler Release 5.2(668)
[NAG Fortran Compiler normal termination]
smaug$nagfor -C=all -c ex_08.5.1.f90
NAG Fortran Compiler Release 5.2(668)
[NAG Fortran Compiler normal termination]
smaug$nagfor -C=all ex_08.5.0.f90 ex_08.5.1.o double.o
NAG Fortran Compiler Release 5.2(668)
Error: ex_08.5.0.f90, line 4: Implicit type for DP
       detected at DP@)
Error: ex_08.5.0.f90, line 4: DP is not a constant
       detected at _@DP
Warning: ex_08.5.0.f90, line 20: Symbol DP referenced but never set
         detected at MAIN@<end-of-statement>
[NAG Fortran Compiler pass 1 error termination, 2 errors, 1 warning]

8.5.2

PROGRAM MAIN
    USE double
    USE Lapack
    IMPLICIT NONE
    REAL(KIND=dp), DIMENSION(5, 5) :: A = 0.0_dp
    REAL(KIND=dp), DIMENSION(5) :: Z
    INTEGER :: I, N
    DO N = 1,10
        CALL RANDOM_NUMBER(Z)
        DO I = 1,5
            A(:, I) = A(:, I) + Z*Z(I)
        END DO
    END DO
    WRITE (*,'(5(1X,5F10.6/))') A
    CALL CHOLESKY(A)
    DO I = 1,5
        A(:I-1,I) = 0.0
    END DO
    WRITE (*, '(5(1X,5F10.6/))') A
    WRITE (*, '(5(1X,5F10.6/))') MATMUL(A, TRANSPOSE(A))
END PROGRAM MAIN

output:
   3.514670  2.419041  1.789385  2.180015  2.809607
   2.419041  2.546670  1.543457  1.411172  2.160570
   1.789385  1.543457  2.645762  1.224709  1.408133
   2.180015  1.411172  1.224709  2.406310  2.142923
   2.809607  2.160570  1.408133  2.142923  3.114639

   1.874745  1.290331  0.954468  1.162833  1.498661
   0.000000  0.938998  0.332139 -0.095066  0.241537
   0.000000  0.000000  1.274534  0.114863 -0.080433
   0.000000  0.000000  0.000000  1.015824  0.425695
   0.000000  0.000000  0.000000  0.000000  0.789069

   3.514670  2.419041  1.789385  2.180015  2.809607
   2.419041  2.546670  1.543457  1.411172  2.160570
   1.789385  1.543457  2.645762  1.224709  1.408133
   2.180015  1.411172  1.224709  2.406310  2.142923
   2.809607  2.160570  1.408133  2.142923  3.114639

It is now declared in the main program from the USE double.

8.5.3

MODULE Lapack
    INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(12)
    PRIVATE :: dp

CONTAINS

SUBROUTINE CHOLESKY(A)
    IMPLICIT NONE
    INTEGER :: J, N
    REAL(KIND=dp) :: A(:, :), X
    N = UBOUND(A,1)
    DO J = 1, N
        X = SQRT(A(J,J)-DOT_PRODUCT(A(J, :J-1), A(J, :J-1)))
        A(J,J) = X
        IF (J < N) &
            A(J+1:, J) = (A(J+1:, J) - &
                MATMUL(A(J+1:, :J-1), A(J,: J-1))) / X
    END DO
END SUBROUTINE CHOLESKY

END MODULE Lapack

output:
   1.006710  1.110161  1.158626  1.195753  0.434136
   1.110161  2.612517  1.885301  2.542489  1.381833
   1.158626  1.885301  3.297817  1.893546  1.734576
   1.195753  2.542489  1.893546  3.374333  1.850713
   0.434136  1.381833  1.734576  1.850713  1.907648

   1.003349  1.106455  1.154758  1.191761  0.432687
   0.000000  1.178251  0.515691  1.038709  0.766462
   0.000000  0.000000  1.303232 -0.014044  0.644298
   0.000000  0.000000  0.000000  0.935374  0.585831
   0.000000  0.000000  0.000000  0.000000  0.612085

   1.006710  1.110161  1.158626  1.195753  0.434136
   1.110161  2.612517  1.885301  2.542489  1.381833
   1.158626  1.885301  3.297817  1.893546  1.734576
   1.195753  2.542489  1.893546  3.374333  1.850713
   0.434136  1.381833  1.734576  1.850713  1.907648

Because the PRIVATE stops it being exported, whether it is declared
in the module or inherited via USE.