PROGRAM SUMMATION ! Summation forwards and backwards of 1/n^2 ! Does not compile if the required precision QUAD is not available. IMPLICIT NONE INTEGER :: N, NMAX CHARACTER :: ANSWER REAL :: SUM_SP, TEMP DOUBLE PRECISION :: SUM_DP INTEGER, PARAMETER :: QUAD = SELECTED_REAL_KIND(20,1000) REAL(KIND=QUAD) :: SUM_QUAD SUM_SP = 0.0 SUM_DP = 0.0D0 SUM_QUAD = 0.0_QUAD 1 WRITE(*,'(A)', ADVANCE='NO') 'How many numbers do you wish to add? ' READ(*,*) TEMP NMAX = NINT(TEMP) IF (NMAX .LT. 10) THEN WRITE(*,*) 'Too few numbers!' GO TO 1 ELSE IF (NMAX .GT. 100000000) THEN WRITE(*,*) 'Too many numbers!' GO TO 1 ENDIF 2 WRITE(*,'(A)', ADVANCE='NO') & & 'Do you want to add forwards (F) or backwards (B)? ' READ(*,*) ANSWER SELECT CASE (ANSWER) CASE('F','f') DO N = 1, NMAX SUM_SP = SUM_SP + 1.0/REAL(N)/REAL(N) SUM_DP = SUM_DP + 1.0D0/DBLE(N)/DBLE(N) SUM_QUAD = SUM_QUAD + 1.0_QUAD/REAL(N,KIND=QUAD)/REAL(N,KIND=QUAD) END DO WRITE(*,*) 'Summation forwards of ',NMAX,' numbers.' CASE('B','b') DO N = NMAX, 1, -1 SUM_SP = SUM_SP + 1.0/REAL(N)/REAL(N) SUM_DP = SUM_DP + 1.0D0/DBLE(N)/DBLE(N) SUM_QUAD = SUM_QUAD + 1.0_QUAD/REAL(N,KIND=QUAD)/REAL(N,KIND=QUAD) END DO WRITE(*,*) 'Summation backwards of ',NMAX,' numbers.' CASE DEFAULT WRITE(*,*) 'Answer F or B!' GO TO 2 END SELECT WRITE(*,*) 'The sum in single precision = ', SUM_SP WRITE(*,*) 'The sum in double precision = ', SUM_DP WRITE(*,*) 'The sum in quad precision = ', SUM_QUAD END PROGRAM SUMMATION