PROGRAM SUMMA ! Summation fram och baklänges av 1/n^2 ! Kompilerar inte om den begärda precisionen QUAD ej finns! IMPLICIT NONE INTEGER :: N, NMAX CHARACTER :: SVAR REAL :: SUM_SP, SLASK 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') 'Hur många tal vill Du summera? ' READ(*,*) SLASK NMAX = NINT(SLASK) IF (NMAX .LT. 10) THEN WRITE(*,*) 'För få tal!' GO TO 1 ELSE IF (NMAX .GT. 100000000) THEN WRITE(*,*) 'För många tal!' GO TO 1 ENDIF 2 WRITE(*,'(A)', ADVANCE='NO') & & 'Vill Du summera framlänges (F) eller baklänges (B)? ' READ(*,*) SVAR SELECT CASE (SVAR) 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 framlänges av ',NMAX,' tal.' 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 baklänges av ',NMAX,' tal.' CASE DEFAULT WRITE(*,*) 'Svara F eller B!' GO TO 2 END SELECT WRITE(*,*) 'Summan i enkel precision = ', SUM_SP WRITE(*,*) 'Summan i dubbel precision = ', SUM_DP WRITE(*,*) 'Summan i fyr-dubbel precision = ', SUM_QUAD END PROGRAM SUMMA