5.1.1

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    CALL diff (X, 1.23, 4.56)
    PRINT *, X
    CALL diff (X, -7.89, 3.42)
    PRINT *, X
    CALL diff (X, 4.29, -0.98)
    PRINT *, X

CONTAINS

    SUBROUTINE diff (P, Q, R)
        IMPLICIT NONE
        REAL :: P, Q, R
        P = Q-R
    END SUBROUTINE diff

END PROGRAM main

this prints:
 -3.3299999
 -11.3099995
   5.2700000

5.1.2

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    CALL diff (X, 1.23, 4.56)
    PRINT *, X
    CALL diff (X, -7.89, 3.42)
    PRINT *, X
    CALL diff (X, 4.29, -0.98)
    PRINT *, X

CONTAINS

    SUBROUTINE diff (P, Q, R)
        IMPLICIT NONE
        REAL, INTENT(OUT) :: P
        REAL, INTENT(IN) :: Q, R
        P = Q-R
    END SUBROUTINE diff

END PROGRAM main

5.1.3

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    CALL diff (R=4.56, Q=1.23, P=X)
    PRINT *, X
    CALL diff (Q=-7.89, P=X, R=3.42)
    PRINT *, X
    CALL diff (R=-0.98, P=X, Q=4.29)
    PRINT *, X

CONTAINS

    SUBROUTINE diff (P, Q, R)
        IMPLICIT NONE
        REAL, INTENT(OUT) :: P
        REAL, INTENT(IN) :: Q, R
        P = Q-R
    END SUBROUTINE diff

END PROGRAM main

5.2.1

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    X = diff(1.23, 4.56)
    PRINT *, X
    X = diff(-7.89, 3.42)
    PRINT *, X
    X = diff(4.29, -0.98)
    PRINT *, X

CONTAINS

    FUNCTION diff (A, B)
        IMPLICIT NONE
        REAL :: diff, A, B
        diff = A-B
    END FUNCTION diff

END PROGRAM main

this prints:

  -3.3299999
 -11.3099995
   5.2700000

5.2.2

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    X = diff(1.23, 4.56)
    PRINT *, X
    X = diff(-7.89, 3.42)
    PRINT *, X
    X = diff(4.29, -0.98)
    PRINT *, X

CONTAINS

    ELEMENTAL FUNCTION diff (A, B)
        IMPLICIT NONE
        REAL :: diff
        REAL, INTENT(IN) :: A, B
        diff = A-B
    END FUNCTION diff

END PROGRAM main

5.2.3

PROGRAM main
    IMPLICIT NONE
    REAL :: X

    X = diff(B=4.56, A=1.23)
    PRINT *, X
    X = diff(B=3.42, A=-7.89)
    PRINT *, X
    X = diff(B=-0.98, A=4.29)
    PRINT *, X

CONTAINS

    ELEMENTAL FUNCTION diff (A, B)
        IMPLICIT NONE
        REAL :: diff
        REAL, INTENT(IN) :: A, B
        diff = A-B
    END FUNCTION diff

END PROGRAM main

5.3.1

MODULE rollem
CONTAINS
    FUNCTION twodice ()
        IMPLICIT NONE
        INTEGER :: twodice
        REAL :: temp
        CALL RANDOM_NUMBER(temp)
        twodice = INT(6.0*temp+1.0)
        CALL RANDOM_NUMBER(temp)
        twodice = twodice+INT(6.0*temp+1.0)
    END FUNCTION twodice
END MODULE rollem

5.3.2

PROGRAM throw
    USE rollem
    IMPLICIT NONE
    INTEGER :: k, n

    DO k = 1,10
        n = twodice()
        PRINT *, n
    END DO
END PROGRAM throw

this prints:

 8
 10
 10
 3
 8
 10
 2
 4
 7
 7

5.4.1

PROGRAM array

CONTAINS

    SUBROUTINE scaler (arg1, arg2)
        IMPLICIT NONE
        REAL, DIMENSION(:, :) :: arg1, arg2
        REAL, DIMENSION(:), ALLOCATABLE :: temp1, temp2
        INTEGER :: m, n

        m = UBOUND(arg1, 1)
        n = UBOUND(arg1, 2)
        IF (m /= UBOUND(arg2, 1) .OR. n /= UBOUND(arg2, 2)) THEN
            PRINT *, 'The arrays are incompatible'
            STOP
        END IF
        ALLOCATE(temp1(1:UBOUND(arg1, 1)))
        ALLOCATE(temp2(1:UBOUND(arg1, 2)))
    END SUBROUTINE scaler

END PROGRAM array

5.4.2

PROGRAM array
    IMPLICIT NONE
    REAL, DIMENSION(3, 4) :: work1, work2 

    work2(1, :) = (/ 2.35, 2.82, 4.55, 7.83 /)
    work2(2, :) = (/ 3.97, 6.75, 7.62, 8.36 /)
    work2(3, :) = (/ 8.97, 0.74, 2.70, 2.49 /)
    CALL scaler(work1, work2)
    PRINT *, work1(1, :)
    PRINT *, work1(2, :)
    PRINT *, work1(3, :)

CONTAINS

    SUBROUTINE scaler (arg1, arg2)
        IMPLICIT NONE
        REAL, DIMENSION(:, :), INTENT(OUT) :: arg1
        REAL, DIMENSION(:, :), INTENT(IN) :: arg2
        REAL, DIMENSION(:), ALLOCATABLE :: temp1, temp2
        INTEGER :: j, k, m, n

        m = UBOUND(arg1, 1)
        n = UBOUND(arg1, 2)
        IF (m /= UBOUND(arg2, 1) .OR. n /= UBOUND(arg2, 2)) THEN
            PRINT *, 'The arrays are incompatible'
            STOP
        END IF
        ALLOCATE(temp1(1:UBOUND(arg1, 1)))
        ALLOCATE(temp2(1:UBOUND(arg1, 2)))
        DO j = 1, m
            temp1(j) = sum(arg2(j, :))/n
        END DO
        DO k = 1, n
            temp2(k) = sum(arg2(:, k))/m
        END DO
        DO j = 1, n
            DO k = 1, m
                arg1(k, j) = arg2(k, j) - temp1(k) - &
                    temp2(j) + sum(temp1)/m
            END DO
        END DO
    END SUBROUTINE scaler

END PROGRAM array

output:

  -2.2049999  -7.4999571E-02   0.1350007   2.1450009
  -2.8725002   1.5675001   0.9175000   0.3875003
   5.0775003  -1.4924996  -1.0524995  -2.5324991

5.5.1

PROGRAM trivial
    IMPLICIT NONE
    INTEGER :: n

    CALL chars(n, 'Kilroy', 'was', 'here')
    PRINT *, n

CONTAINS

    SUBROUTINE chars (count, str1, str2, str3)
        IMPLICIT NONE
        INTEGER, INTENT(OUT) :: count
        CHARACTER(LEN=*), INTENT(IN) :: str1, str2, str3

        PRINT *, str1
        PRINT *, str2
        PRINT *, str3
        count = LEN(str1)+LEN(str2)+LEN(str3)
    END SUBROUTINE chars

END PROGRAM trivial

this prints:
 Kilroy
 was
 here
 13

5.6.1

    PROGRAM trivial
        IMPLICIT NONE

        PRINT *, dotit('How, now, brown cow?')
        PRINT *, dotit('   Spaced out     ')

    CONTAINS

        PURE FUNCTION dotit (string)
            IMPLICIT NONE
            CHARACTER(LEN=*), INTENT(IN) :: string
            CHARACTER(LEN=LEN(STRING)) :: dotit

            dotit = TRIM(ADJUSTL(string)) // REPEAT('.', LEN(string))
        END FUNCTION dotit

    END PROGRAM trivial

output:
 How, now, brown cow?
 Spaced out........

5.7.1

PROGRAM Main
    IMPLICIT NONE
    INTEGER :: result, n

    DO n = 1,5
        CALL counter(result)
        PRINT *, result
    END DO

CONTAINS

    SUBROUTINE counter (count)
        IMPLICIT NONE
        INTEGER, INTENT(OUT) :: count
        INTEGER, SAVE :: state = 7

        count = state
        state = state+1
    END SUBROUTINE counter

END PROGRAM Main

output:
 7
 8
 9
 10
 11

5.8.1

MODULE Solver
CONTAINS

    SUBROUTINE Newton (value)
        IMPLICIT NONE
        REAL, INTENT(IN) :: value
        REAL :: solution, last, previous

        IF ( value < 1.0) THEN
            PRINT *, 'Value of X*LOG(X) out of range'
            RETURN
        END IF
        solution = value            
        last = 2.0*value
        previous = 3.0*value
        DO
            solution = solution - &
                (Fn1(solution) - value) / Fn2(solution)
            IF (solution == last .OR. solution == previous) EXIT
            previous = last
            last = solution
        END DO
        PRINT *, 'X*LOG(X) =', value, '    X =', solution
    END SUBROUTINE Newton

    PURE FUNCTION Fn1 (arg)
        IMPLICIT NONE
        REAL :: Fn1
        REAL, INTENT(IN) :: arg

        Fn1 = arg*LOG(arg)
    END FUNCTION Fn1

    PURE FUNCTION Fn2 (arg)
        IMPLICIT NONE
        REAL :: Fn2
        REAL, INTENT(IN) :: arg

        Fn2 = LOG(arg)+1.0
    END FUNCTION Fn2

END MODULE Solver

5.8.2

PROGRAM Tester
    USE Solver
    IMPLICIT NONE

    CALL Newton(1.23)
    CALL Newton(456.7)
    CALL Newton(8.9e5)
END PROGRAM Tester

output:
 X*LOG(X) =   1.2300000     X =   1.9063751
 X*LOG(X) =   4.5670001E+02     X =  99.3186035
 X*LOG(X) =   8.9000000E+05     X =   7.8926766E+04