Документ взят из кэша поисковой машины. Адрес оригинального документа : http://star.arm.ac.uk/f77to90/code/sum.f90 Дата изменения: Fri Mar 8 14:17:46 1996 Дата индексирования: Tue Oct 2 02:26:10 2012 Кодировка: Поисковые слова: http www.astronomy.ru forum index.php topic 4644.0.html

PROGRAM SUMMATION
! Summation forwards and backwards of 1/n^2
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