mirror of
https://github.com/gryf/tagbar.git
synced 2026-01-06 22:04:11 +01:00
Add tests to repository
This commit is contained in:
Jan Larres
7
tests/fortran/block.f
Normal file
7
tests/fortran/block.f
Normal file
@@ -0,0 +1,7 @@
|
||||
block data
|
||||
integer nmax
|
||||
parameter (nmax=20)
|
||||
real v(nmax), alpha, beta
|
||||
common /vector/v,alpha,beta
|
||||
data v/20*100.0/, alpha/3.14/, beta/2.71/
|
||||
end
|
||||
150
tests/fortran/fall1.f
Normal file
150
tests/fortran/fall1.f
Normal file
@@ -0,0 +1,150 @@
|
||||
c<html>
|
||||
c<body>
|
||||
c<pre>
|
||||
module constants
|
||||
integer, parameter :: np=2000, dbl=selected_real_kind(14,100)
|
||||
real(dbl) :: g=9.807,dtmin=.001
|
||||
end module constants
|
||||
c
|
||||
program fall
|
||||
use constants
|
||||
implicit none
|
||||
c
|
||||
c Program to calculate the dynamics of a falling body
|
||||
c
|
||||
c John Mahaffy 4/15/95
|
||||
c
|
||||
c Arrays:
|
||||
c v - velocity at each time integration step
|
||||
c z - height at each time integration step
|
||||
c t - time for each corresponding v and z
|
||||
c zreal - Actual height at time t(i) for comparison with computed z
|
||||
c
|
||||
c In this program, I am using allocatate just to save space in the
|
||||
c executable program file (a.out). No attempt is made to estimate a size.
|
||||
c Module "constants" communicates between subroutines.
|
||||
c
|
||||
c<a name="alable"><font color="FF0000">
|
||||
real(dbl), allocatable :: v(:),z(:),t(:), zreal(:)
|
||||
c</font></a>
|
||||
real(dbl) dt
|
||||
integer nsteps
|
||||
c<a name="all"><font color="FF0000">
|
||||
allocate (v(np),z(np),t(np),zreal(np))
|
||||
c</font></a>
|
||||
call input(z,dt)
|
||||
call odesolve(v,z,t,dt,nsteps)
|
||||
call realans(t,z,nsteps,zreal)
|
||||
call output (t,z,zreal,v,nsteps)
|
||||
stop
|
||||
end
|
||||
c
|
||||
subroutine input (z,dt)
|
||||
use constants
|
||||
implicit none
|
||||
c
|
||||
c Obtain user input for initial height and time step
|
||||
c
|
||||
c John Mahaffy 4/15/95
|
||||
c
|
||||
c Output Arguments:
|
||||
c z(1) - initial height
|
||||
c dt - integration time step
|
||||
c
|
||||
real(dbl) z(*),dt
|
||||
c
|
||||
write(6,'(a)',advance='no') ' Initial height (meters): '
|
||||
read *, z(1)
|
||||
write(6,'(a)',advance='no') 'Time step size (seconds): '
|
||||
read *, dt
|
||||
if(dt.le.0.) dt=dtmin
|
||||
return
|
||||
end
|
||||
c
|
||||
subroutine odesolve(v,z,t,dt,nsteps)
|
||||
use constants
|
||||
c
|
||||
c Solve the Ordinary Differential Equation of motion for the body
|
||||
c
|
||||
c John Mahaffy 4/15/95
|
||||
c
|
||||
c Arguments:
|
||||
c Input
|
||||
c dt - timestep size
|
||||
c Output:
|
||||
c v - velocity
|
||||
c z - height
|
||||
c t - time
|
||||
c nsteps - last step in the integration
|
||||
c
|
||||
real (dbl) v(*),z(*),t(*),dt
|
||||
integer i, nsteps
|
||||
c
|
||||
c Solve the equation for a falling body
|
||||
c
|
||||
c d v d z
|
||||
c --- = - g --- = v
|
||||
c d t d t
|
||||
c
|
||||
c Set remaining initial conditions:
|
||||
c
|
||||
t(1)=0.
|
||||
v(1)=0.
|
||||
c
|
||||
c Now loop through time steps until z goes negative or we run out of space
|
||||
c
|
||||
do 100 i=2,np
|
||||
v(i)= v(i-1)-dt*g
|
||||
z(i)= z(i-1)+dt*.5*(v(i)+v(i-1))
|
||||
t(i)=t(i-1)+dt
|
||||
if(z(i).lt.0.) go to 200
|
||||
c<a name="con"><font color="FF0000">
|
||||
100 continue
|
||||
c</font></a>
|
||||
write(6,*) 'Ran out of space to continue integration'
|
||||
write(6,*) ' Last height was ',z(np),' meters'
|
||||
i=np
|
||||
200 nsteps=i
|
||||
c return
|
||||
end
|
||||
c
|
||||
subroutine realans(t,z,nsteps,zreal)
|
||||
use constants
|
||||
c
|
||||
c Get the values of the analytic solution to the differential equation
|
||||
c for each time point to check the numerical accuracy.
|
||||
c
|
||||
c John Mahaffy 4/15/95
|
||||
c
|
||||
real(dbl) t(*),z(*),zreal(*)
|
||||
integer i,nsteps
|
||||
c
|
||||
do 10 i=1,nsteps
|
||||
10 zreal(i)=z(1)-.5*g*t(i)**2
|
||||
return
|
||||
end
|
||||
c
|
||||
subroutine output(t,z,zreal,v,nsteps)
|
||||
use constants, only : dbl
|
||||
implicit none
|
||||
c
|
||||
c Outputs the full results of the time integration
|
||||
c
|
||||
c John Mahaffy 4/15/95
|
||||
c
|
||||
real(dbl) v(*),z(*),t(*), zreal(*)
|
||||
integer nsteps,i
|
||||
print *, 'Results are in fall.output'
|
||||
open (11,file='fall.output')
|
||||
write(11,2000)
|
||||
do 300 i=1,nsteps
|
||||
write(11,2001) t(i),v(i),z(i),zreal(i)
|
||||
300 continue
|
||||
2000 format (33x,'Computed',8x,'Actual',/,
|
||||
& 6x,'Time',9x,'Velocity', 8x,'Height',8x,'Height')
|
||||
2001 format (1x,1p,4e15.7)
|
||||
return
|
||||
end
|
||||
c</pre>
|
||||
c</body>
|
||||
c</html>
|
||||
55
tests/fortran/htcoef.f
Normal file
55
tests/fortran/htcoef.f
Normal file
@@ -0,0 +1,55 @@
|
||||
program htcoef
|
||||
c
|
||||
c John Mahaffy, Penn State University, CmpSc 201 Example
|
||||
c 1/26/96
|
||||
c
|
||||
implicit none
|
||||
real k,D,Pr,h,Nulam,Nuturb
|
||||
real Re1,Re2,Re3,Re4
|
||||
c
|
||||
c Calculate an approximation for heat transfer coefficients
|
||||
c in a 1 inch pipe for several different Reynolds numbers
|
||||
c
|
||||
c An example of why you should learn to use subprograms
|
||||
c
|
||||
c h - heat transfer coefficient ( w/m**2/K)'
|
||||
c Nulam - laminar Nusselt number
|
||||
c Nuturb - Turbulent Nusselt number (Dittus-Boelter correlation)
|
||||
c k - conductivity ( w/m/K)'
|
||||
c D - hydraulic diameter (m)
|
||||
c Re - Reynolds number
|
||||
c Pr - Prandl number
|
||||
c
|
||||
data k,D,Pr/0.617,0.0254,1.0/, Nulam/4.0/
|
||||
c
|
||||
c Each of the following blocks assigns a Reynolds number, calculates
|
||||
c an associated Turbulent Nusselt number and calculates the heat
|
||||
c transfer coefficient based on the maximum of Turbulent and Laminar
|
||||
c Nusselt Numbers
|
||||
c
|
||||
Re1=10.
|
||||
Nuturb=0.023*Re1**0.8*Pr**0.4
|
||||
h=k/D*max(Nulam,Nuturb)
|
||||
print *, 'For Reynolds Number = ',Re1
|
||||
print *, 'Heat Transfer Coefficient is ',h,' w/m**2/K'
|
||||
c
|
||||
Re2=100.
|
||||
Nuturb=0.023*Re2**0.8*Pr**0.4
|
||||
h=k/D*max(Nulam,Nuturb)
|
||||
print *, 'For Reynolds Number = ',Re2
|
||||
print *, 'Heat Transfer Coefficient is ',h,' w/m**2/K'
|
||||
c
|
||||
Re3=1000.
|
||||
Nuturb=0.023*Re3**0.8*Pr**0.4
|
||||
h=k/D*max(Nulam,Nuturb)
|
||||
print *, 'For Reynolds Number = ',Re3
|
||||
print *, 'Heat Transfer Coefficient is ',h,' w/m**2/K'
|
||||
c
|
||||
Re4=10000.
|
||||
Nuturb=0.023*Re4**0.8*Pr**0.4
|
||||
h=k/D*max(Nulam,Nuturb)
|
||||
print *, 'For Reynolds Number = ',Re4
|
||||
print *, 'Heat Transfer Coefficient is ',h,' w/m**2/K'
|
||||
c
|
||||
stop
|
||||
end
|
||||
22
tests/fortran/linint1.f
Normal file
22
tests/fortran/linint1.f
Normal file
@@ -0,0 +1,22 @@
|
||||
subroutine linint(x,y)
|
||||
c
|
||||
c Given a value of x return a value of y based on interpolation
|
||||
c within a table of y values (ytab) evaluated at evenly spaced
|
||||
c x points between xmin and xmax.
|
||||
c
|
||||
c John Mahaffy 2/12/95
|
||||
c
|
||||
real ytab(11)
|
||||
parameter (xmin=300.,dx=100.,xmax=xmin+10.*dx,rdx=1./dx)
|
||||
data ytab/1.0,2.1,3.2,4.4,5.7,7.1,8.6,10.2,11.9,13.7,15.8/
|
||||
if(x.ge.xmin.and.x.le.xmax) then
|
||||
i1= int((x-xmin)*rdx)+1
|
||||
x1=xmin+(i1-1)*dx
|
||||
wx=(x-x1)*rdx
|
||||
y=(1-wx)*ytab(i1)+wx*ytab(i1+1)
|
||||
else
|
||||
write(6,*) 'x = ', x, ' is out of table range'
|
||||
stop
|
||||
endif
|
||||
return
|
||||
end
|
||||
209
tests/fortran/plot2.f
Normal file
209
tests/fortran/plot2.f
Normal file
@@ -0,0 +1,209 @@
|
||||
c<html>
|
||||
c<head><title>plot2.f</title></head>
|
||||
c<body>
|
||||
c<pre>
|
||||
|
||||
program plotit
|
||||
c
|
||||
c Program to provide plots of Sin(x)
|
||||
c Ascii Character plots go to terminal and file 'pplot.out'
|
||||
c
|
||||
c John Mahaffy 2/1/95
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
c The following line tells Fortran that "func" is a function or subroutine
|
||||
c and not a variable
|
||||
c
|
||||
c<a name="ex"><font color="FF0000">
|
||||
external func
|
||||
c</font></a>
|
||||
c
|
||||
c The next line is necessary to pass the location of the intrinsic sin
|
||||
c function as an argument to a subprogram
|
||||
c
|
||||
c<a name="intrinsic"><font color="FF0000">
|
||||
intrinsic sin
|
||||
c</font></a>
|
||||
c
|
||||
call pplot(func,0.,6.)
|
||||
print *, 'Hit the Enter key to continue'
|
||||
c<a name="pause"><font color="FF0000">
|
||||
pause
|
||||
c</font></a>
|
||||
call gnuplot('x','y','sin(x)',func,0.0,6.0)
|
||||
call gnuplot('x','y','Intrinsic sin(x)',sin,0.0,6.0)
|
||||
stop
|
||||
end
|
||||
subroutine pplot(f,xmin,xmax)
|
||||
c
|
||||
c Generate ASCII character plot to screen and file 'pplot.out'
|
||||
c
|
||||
implicit none
|
||||
character line*72
|
||||
real x, f , xmin , xmax
|
||||
integer ip,i,imax
|
||||
c
|
||||
c The following line tells Fortran that f is a function or subroutine
|
||||
c and not a variable
|
||||
c
|
||||
external f
|
||||
c
|
||||
c INPUT Arguments
|
||||
c
|
||||
c f - function to be ploted
|
||||
c xmin - minimum x value
|
||||
c xmax - maximum x value
|
||||
c
|
||||
c OTHER key variables
|
||||
c
|
||||
c line - Character string loaded with a line of output
|
||||
c ip - Position in line for a function value
|
||||
c
|
||||
open (11,file='pplot.out')
|
||||
c
|
||||
c Label values of the y axis
|
||||
c
|
||||
line=' '
|
||||
line(14:15)='-1'
|
||||
line(65:65)='1'
|
||||
write(*,*) line
|
||||
write(11,*) line
|
||||
line=' '
|
||||
write(line(10:13),'(f4.1)') xmin
|
||||
c
|
||||
c Draw the y axis
|
||||
c
|
||||
line(15:40)='+----+----+----+----+----+'
|
||||
line(41:65)=line(16:40)
|
||||
c
|
||||
c Plot the value at x=0
|
||||
c
|
||||
ip= nint(25*f(0.0))+40
|
||||
line(ip:ip)='*'
|
||||
write(*,*) line
|
||||
write(11,*) line
|
||||
line=' '
|
||||
imax=nint((xmax-xmin)*10)
|
||||
c
|
||||
c Limit output
|
||||
c
|
||||
imax=min(1000,imax)
|
||||
c
|
||||
c Loop through and plot points for other x values
|
||||
c
|
||||
do 50 i=1,imax
|
||||
x=.1*i
|
||||
ip=nint(25*f(x))+40
|
||||
c
|
||||
if(mod(i,10).eq.0) then
|
||||
write(line(10:13),'(f4.1)') x
|
||||
line(40:40)='+'
|
||||
c<a name="else"><font color="FF0000">
|
||||
else
|
||||
c</font></a>
|
||||
line(10:13)=' '
|
||||
line(40:40)='|'
|
||||
endif
|
||||
line(ip:ip)='*'
|
||||
write(*,*) line
|
||||
write(11,*) line
|
||||
50 line(ip:ip)=' '
|
||||
c<a name="close"><font color="FF0000">
|
||||
close (11)
|
||||
c</font></a>
|
||||
return
|
||||
end
|
||||
subroutine gnuplot(xlabel,ylabel,title,f,xmin,xmax)
|
||||
c
|
||||
c Ship data to the public domain program "gnuplot" for plotting
|
||||
c
|
||||
implicit none
|
||||
character line*72,sq*1
|
||||
real x,f,xmin,xmax,fx
|
||||
character*(*) xlabel,ylabel,title
|
||||
integer i,imax,lc
|
||||
external f
|
||||
data sq/''''/
|
||||
c
|
||||
c INPUT Arguments
|
||||
c
|
||||
c f - function to be ploted
|
||||
c xmin - minimum x value
|
||||
c xmax - maximum x value
|
||||
c xlabel - Contains a label for the x-axis
|
||||
c ylabel - Contains a label for the y-axis
|
||||
c title - Contains a title for the plot
|
||||
c
|
||||
c OTHER key variables
|
||||
c
|
||||
c line - Contains a line of character data
|
||||
c
|
||||
c Drive a separate true graphics program (gnuplot)
|
||||
c
|
||||
c First set up the command file for gnuplot
|
||||
c Run gnuplot interactively and use the "help" command to learn more
|
||||
c about what I am doing.
|
||||
c
|
||||
open (12,file='gnuxy')
|
||||
c
|
||||
c UnComment the next line if you are on a NCSA/BYU Telnet Session
|
||||
c
|
||||
c write(12,*) 'set terminal tek40xx'
|
||||
c
|
||||
write(12,*) 'set data style lines'
|
||||
c <a name=1><font color=FF0000>
|
||||
lc=len(xlabel)
|
||||
c </font>
|
||||
line='set xlabel '''//xlabel(1:lc)//sq
|
||||
write(12,*)line
|
||||
c
|
||||
c You don't really need to calculate the character variable length
|
||||
c here. The following works just fine because of the character*(*)
|
||||
c
|
||||
line='set ylabel '''//ylabel//sq
|
||||
write(12,*)line
|
||||
line='set title '''//title//sq
|
||||
write(12,*)line
|
||||
write(12,*)'set nokey'
|
||||
write(12,2000) xmin,xmax
|
||||
2000 format('set xrange [',f3.0,':',f3.0,']')
|
||||
write(12,*) 'plot ''dataxy'' using 1:2'
|
||||
write(12,*) 'pause 10'
|
||||
close(12)
|
||||
c
|
||||
c Generate x-y pairs for the graph
|
||||
c
|
||||
open (12,file='dataxy')
|
||||
imax=nint((xmax-xmin)*10)
|
||||
c
|
||||
c Limit output
|
||||
c
|
||||
imax=min(1000,imax)
|
||||
c
|
||||
do 100 i=0,imax
|
||||
x=.1*i
|
||||
fx=f(x)
|
||||
write(12,*) x,fx
|
||||
100 continue
|
||||
close(12)
|
||||
c
|
||||
c Tell the system to run the program gnuplot
|
||||
c This call works on either IBM RS6000 or Sun, but is not part of
|
||||
c the Fortran standard.
|
||||
c Comment out the line if you aren't at a terminal with graphics
|
||||
c
|
||||
call system('gnuplot gnuxy')
|
||||
c<a name="10"><font color="FF0000">
|
||||
return
|
||||
c</a></font>
|
||||
end
|
||||
c<a name="fun"><font color="FF0000">
|
||||
real function func(x)
|
||||
c</font></a>
|
||||
func=sin(x)
|
||||
return
|
||||
end
|
||||
c</pre>
|
||||
c</body>
|
||||
c</html>
|
||||
73
tests/fortran/thcl.f
Normal file
73
tests/fortran/thcl.f
Normal file
@@ -0,0 +1,73 @@
|
||||
function thcl(temp)
|
||||
c
|
||||
c function thcl evaluates the freon liquid thermal conductivity
|
||||
c as a function of liquid enthalpy
|
||||
c
|
||||
c liquid temperature temp in (j/kg)
|
||||
c thermal conductivity thcl in (w/m/k)
|
||||
c
|
||||
c
|
||||
c
|
||||
dimension tabl(4,26)
|
||||
save ilast
|
||||
data ilast/15/,ntab/26/
|
||||
data tabl/
|
||||
& 1.99826700E+02, 1.15267000E-01,-3.03660304E-04, 6.96601393E-07,
|
||||
& 2.10937800E+02, 1.11979000E-01,-2.88180288E-04, 6.96601393E-07,
|
||||
& 2.22048900E+02, 1.08863000E-01,-2.72700273E-04,-6.88501377E-07,
|
||||
& 2.33160000E+02, 1.05748000E-01,-2.88000288E-04, 6.88501377E-07,
|
||||
& 2.44271100E+02, 1.02633000E-01,-2.72700273E-04,-6.96601393E-07,
|
||||
& 2.55382200E+02, 9.95170000E-02,-2.88180288E-04, 7.04701409E-07,
|
||||
& 2.66493300E+02, 9.64020000E-02,-2.72520273E-04,-7.04701409E-07,
|
||||
& 2.77604400E+02, 9.32870000E-02,-2.88180288E-04, 6.96822277E-07,
|
||||
& 2.88715600E+02, 9.01710000E-02,-2.72695225E-04,-6.88955687E-07,
|
||||
& 2.99826700E+02, 8.70560000E-02,-2.88005336E-04, 6.88955687E-07,
|
||||
& 3.10937800E+02, 8.39410000E-02,-2.72695225E-04,-6.97055703E-07,
|
||||
& 3.22048900E+02, 8.08250000E-02,-2.88185336E-04, 7.05155719E-07,
|
||||
& 3.33160000E+02, 7.77100000E-02,-2.72515225E-04,-7.05155719E-07,
|
||||
& 3.44271100E+02, 7.45950000E-02,-2.88185336E-04, 6.97055703E-07,
|
||||
& 3.55382200E+02, 7.14790000E-02,-2.72695225E-04,-6.88955687E-07,
|
||||
& 3.66493300E+02, 6.83640000E-02,-2.88005336E-04, 6.88955687E-07,
|
||||
& 3.77604400E+02, 6.52490000E-02,-2.72695225E-04,-6.96822277E-07,
|
||||
& 3.88715600E+02, 6.21330000E-02,-2.88180288E-04, 7.04701409E-07,
|
||||
& 3.99826700E+02, 5.90180000E-02,-2.72520273E-04,-7.04701409E-07,
|
||||
& 4.10937800E+02, 5.59030000E-02,-2.88180288E-04, 6.96601393E-07,
|
||||
& 4.22048900E+02, 5.27870000E-02,-2.72700273E-04,-4.89240978E-06,
|
||||
& 4.33160000E+02, 4.91530000E-02,-3.81420381E-04, 6.80401361E-07,
|
||||
& 4.44271100E+02, 4.49990000E-02,-3.66300366E-04,-6.28561257E-06,
|
||||
& 4.55382200E+02, 4.01530000E-02,-5.05980506E-04,-2.45592491E-05,
|
||||
& 4.66493300E+02, 3.14990000E-02,-1.05174105E-03,-2.18924207E-04,
|
||||
& 4.70937800E+02, 2.25000000E-02, 0.00000000E+00, 0.00000000E+00/
|
||||
x=temp
|
||||
c Start the search from the last point of table use index
|
||||
c
|
||||
if (x.le.tabl(1,ilast+1)) then
|
||||
c
|
||||
c Search down the table from point of last use
|
||||
c
|
||||
do 20 i1=ilast,1,-1
|
||||
if(x.ge.tabl(1,i1)) go to 60
|
||||
20 continue
|
||||
c write(6,*) 'x = ', x, ' is below the table range'
|
||||
i1=1
|
||||
go to 60
|
||||
else
|
||||
c
|
||||
c Search up the table from point of last use
|
||||
c
|
||||
do 40 i1=ilast+1,ntab-1
|
||||
if(x.le.tabl(1,i1+1)) go to 60
|
||||
40 continue
|
||||
c write(6,*) 'x = ', x, ' is above the table range'
|
||||
i1=ntab-1
|
||||
go to 60
|
||||
endif
|
||||
c
|
||||
c Bounding points found, interpolate
|
||||
c
|
||||
60 dx=(x-tabl(1,i1))
|
||||
thcl=tabl(2,i1)+tabl(3,i1)*dx+tabl(4,i1)*dx**2
|
||||
ilast=i1
|
||||
120 continue
|
||||
return
|
||||
end
|
||||
Reference in New Issue
Block a user