aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

30
Task/Trabb-Pardo-Knuth-algorithm/Fortran/trabb-pardo-knuth-algorithm-1.f Normal file
View file

@ -0,0 +1,30 @@
program tpk
implicit none
real, parameter :: overflow = 400.0
real :: a(11), res
integer :: i
write(*,*) "Input eleven numbers:"
read(*,*) a
a = a(11:1:-1)
do i = 1, 11
res = f(a(i))
write(*, "(a, f0.3, a)", advance = "no") "f(", a(i), ") = "
if(res > overflow) then
write(*, "(a)") "overflow!"
else
write(*, "(f0.3)") res
end if
end do
contains
real function f(x)
real, intent(in) :: x
f = sqrt(abs(x)) + 5.0*x**3
end function
end program

16
Task/Trabb-Pardo-Knuth-algorithm/Fortran/trabb-pardo-knuth-algorithm-2.f Normal file
View file

@ -0,0 +1,16 @@
C THE TPK ALGORITH - FORTRAN I - 1957 TPK00010
FTPKF(X)=SQRTF(ABSF(X))+5.0*X**3 TPK00020
DIMENSION A(11) TPK00030
READ 100,A TPK00040
100 FORMAT(6F12.4/) TPK00050
DO 3 I=1,11 TPK00060
J=12-I TPK00070
Y=FTPKF(A(J)) TPK00080
IF (Y-400.0)2,2,1 TPK00090
1 PRINT 301,I,A(J) TPK00100
301 FORMAT(I10,F12.7,18H *** TOO LARGE ***) TPK00110
GO TO 10 TPK00120
2 PRINT 302,I,A(J),Y TPK00130
302 FORMAT(I10,2F12.7) TPK00140
3 CONTINUE TPK00150
STOP 0 TPK00160