Debugging old Fortran code for sediment dynamics - fortran

I am looking at some Fortran code from an old scanned paper. The scan quality is not great so I may have copied it wrong. I tried to run this using an online Fortran compiler but it bombs out. Not being familiar with Fortran, I was wondering if someone can point out where the syntax does not make sense? The code is from a paper on sediment dynamics:
Komar, P.D. and Miller, M.C., 1975. On the comparison between the threshold of sediment motion under waves and unidirectional currents with a discussion of the practical evaluation of the threshold: Reply. Journal of Sedimentary Research, 45(1).
PROGRAM TSHOLD
REAL LI, LO
G = 981.0
PIE = 3.1416
RHOW = 1.00
READ (6O,1) DIAM, RHOS
1 FORMAT (2X, F6.3,2X, F5.3)
IF(DIAM .LT. 0.05) GO TO 5
A = 0.463 * PIE
B = 0.25
GO TO 7
5 A = 0.21
B = 0.50
7 PWR = 1.0 / (2.0 - B)
FAC = (A * (RHOS - RHOW) * G/(RHOW * PIE**B))**PWR
FAC1 = FAC * DIAM**((1.0 - B) * PWR)
T = 1.0
15 J = 1.20
LD = 156.13 * (T**2)
UM = FAC1 * T**(B*PWR)
WRITE(61,9) DIAM, T, UM
9 FORMAT(1H0, 10X, 17HGRAIN DIAMETER = ,F6.3,1X,2HCM //
1 11X, 14HWAVE PERIOD = ,F5.2, 1X, 3HSEC //
2 11X, 22HORBITAL VELOCITY, UM = ,F6.2, 1X, 6HCM/SECl //
3 20X, 6HHEIGHT, 5X, 5HDEPTH, 8X, 3HH/L, 6X, 7HH/DEPTH //
4 22X, 2HCM, 8X, 2HCM /)
C INCREMENT WAVE HEIGHT, CALCULATE DEPTH
H = 10.0
DO 12 K = 1.60
SING = PIE * H / (UM * T)
X = SING
IF(X.LT.1.0) GO TO 30
30 ASINH = X - 0.16666*X**3.0 + 0.07500* X ** 5.0 - 0.04464 * X ** 7.0
1 + 0.03038 * X ** 9.0 - 0.02237 * X ** 11.0
32 LI = LD * (SINH(ASINH)/COSH(ASINH))
OPTH = ASINH * LI / 6.2832
C CHECK WAVE STABILITY
RATIO = H / DPTH
IF(RATIO.GE.0.78) GO TO 11
STEEP = H / LI
TEST = 0.142 * (SINH(ASINH)/COSH(ASINH))
IF(STEEP.GE.TEST) GO TO 11
WRITE(61,10) H, OPTH, STEEP, RATIO
I0 FORMAT(IH0, 20X, F5.1, 4X, E9.3, 4X, F5.3, 4X, F4.2)
11 H = H + 10.0
12 CONTINUE
T = T + 1.0
15 CONTINUE
END

The problem is more likely that old Fortran requires fixed form code formatting where the number of spaces before a statement is very important.
Here are some general rules
Normal statements start at column 7 and beyond
Lines cannot exceed 72 columns
Any character placed on column 6 indicates the line is a continuation from the line above. I see that on the code above in the lines following 9 FORMAT(..
A number placed between columns 1-5 indicates a label, which can be a target of a GO TO statement, a DO statement or a formatting specification.
The character C on the first column, and sometimes any character on the first column indicate the line is a comment line.
see https://people.cs.vt.edu/~asandu/Courses/MTU/CS2911/fortran_notes/node4.html for more info.
Based on the rules above, here is how to enter the code, with the correct spacing. I run the F77 code through a converter to make it compatible with F90 and F77 at the same time. The code below might compile with the online compiler now.
PROGRAM TSHOLD
REAL LI, LO
G = 981.0
PIE = 3.1416
RHOW = 1.00
READ (60,1) DIAM, RHOS
1 FORMAT (2X, F6.3,2X, F5.3)
IF(DIAM .LT. 0.05) GO TO 5
A = 0.463 * PIE
B = 0.25
GO TO 7
5 A = 0.21
B = 0.50
7 PWR = 1.0 / (2.0 - B)
FAC = (A * (RHOS - RHOW) * G/(RHOW * PIE**B))**PWR
FAC1 = FAC * DIAM**((1.0 - B) * PWR)
T = 1.0
DO 15 J=1,20
LD = 156.13 * (T**2)
UM = FAC1 * T**(B*PWR)
WRITE(61,9) DIAM, T, UM
9 FORMAT(1H0, 10X, 17HGRAIN DIAMETER = ,F6.3,1X,2HCM // &
& 11X, 14HWAVE PERIOD = ,F5.2, 1X, 3HSEC // &
& 11X, 22HORBITAL VELOCITY, UM = ,F6.2, 1X, 6HCM/SECl // &
& 20X, 6HHEIGHT, 5X, 5HDEPTH, 8X, 3HH/L, 6X, 7HH/DEPTH // &
& 22X, 2HCM, 8X, 2HCM /)
! INCREMENT WAVE HEIGHT, CALCULATE DEPTH
H = 10.0
DO 12 K = 1,60
SING = PIE * H / (UM * T)
X = SING
IF(X.LT.1.0) GO TO 30
30 ASINH = X - 0.16666*X**3.0 + 0.07500* X ** 5.0 - 0.04464 * X ** 7.&
& + 0.03038 * X ** 9.0 - 0.02237 * X ** 11.0
32 LI = LD * (SINH(ASINH)/COSH(ASINH))
OPTH = ASINH * LI / 6.2832
! CHECK WAVE STABILITY
RATIO = H / DPTH
IF(RATIO.GE.0.78) GO TO 11
STEEP = H / LI
TEST = 0.142 * (SINH(ASINH)/COSH(ASINH))
IF(STEEP.GE.TEST) GO TO 11
WRITE(61,10) H, OPTH, STEEP, RATIO
10 FORMAT(G14.4, 20X, F5.1, 4X, E9.3, 4X, F5.3, 4X, F4.2)
11 H = H + 10.0
12 CONTINUE
T = T + 1.0
15 CONTINUE
END
I found several transcription errors, replacing commas with dots, zeros with the letter O, and a missing DO statement.

Related

Detecting unit differences in data (SAS)

I have two sets of financial data that tend to contain differences due to unit errors e.g. $10000 in one dataset may be $1000 in the other.
I'm trying to code a check for such differences, but the only way I can think of is to divide the two variables and see if the difference is in a table of 0.001, 0.01, 0.1, 10, 100 etc, but it would be hard to catch all of the differences.
Is there a smarter way to do this?
Use proc compare. Be sure the two datasets are sorted in identical order, either by row or by specific groups. Use the by statement as needed. More info on options can be found in the documentation.
Example - compare a modified cars dataset with sashelp.cars:
data cars_modified;
set sashelp.cars;
if(mod(_N_, 2) = 0) then msrp = msrp - 100;
run;
proc compare base = sashelp.cars
compare = cars_modified
out = out_differences
outnoequal
outdif
noprint;
var msrp;
run;
Only the observations with differences are output in out_differences:
_TYPE_ _OBS_ MSRP
DIF 2 $-100
DIF 4 $-100
DIF 6 $-100
DIF 8 $-100
DIF 10 $-100
...
So you appear to be asking to find cases where X/Y is a number that is exactly 1.00Exx where XX is an integer, other than 0.
data _null_;
do x=1,10,100,1000;
do y=1,2,3,10.1,10 ;
ratio = x/y;
power = floor(log10(ratio));
if power ne 0 and 1.00 = round(ratio/10**power,0.01) then
put 'Ratio of ' x 'over ' y 'is 10**' power '.'
;
end;
end;
run;
Results:
Ratio of 1 over 10 is 10**-1 .
Ratio of 10 over 1 is 10**1 .
Ratio of 100 over 1 is 10**2 .
Ratio of 100 over 10 is 10**1 .
Ratio of 1000 over 1 is 10**3 .
Ratio of 1000 over 10 is 10**2 .
For a numeric value X you can compute the nearest the rational expression, p/q.
If you calculate ratio
X = amount_for_source_A / amount_from_source_B;
status = math.rational(X,1e5,p,q);
the ratio will be a multiple of 10 if p=1 or q=1
Example:
proc ds2;
package math / overwrite = yes;
method rational(double x, double maxden, in_out integer p, in_out integer q) returns double;
/*
** FROM: https://www.ics.uci.edu/~eppstein/numth/frap.c
** FROM: https://stackoverflow.com/questions/95727/how-to-convert-floats-to-human-readable-fractions
**
** find rational approximation to given real number
** David Eppstein / UC Irvine / 8 Aug 1993
**
** With corrections from Arno Formella, May 2008
**
** Modified for Proc DS2, Richard DeVenezia, Jan 2020.
**
** usage: rational(r,d,p,q)
** x is real number to approx
** maxden is the maximum denominator allowed
** p is return for numerator
** q is return for denominator
** returns 0 if no problems
**
** based on the theory of continued fractions
** if x = a1 + 1/(a2 + 1/(a3 + 1/(a4 + ...)))
** then best approximation is found by truncating this series
** (with some adjustments in the last term).
**
** Note the fraction can be recovered as the first column of the matrix
** ( a1 1 ) ( a2 1 ) ( a3 1 ) ...
** ( 1 0 ) ( 1 0 ) ( 1 0 )
** Instead of keeping the sequence of continued fraction terms,
** we just keep the last partial product of these matrices.
*/
declare integer m[0:1,0:1];
declare double startx e1 e2;
declare integer ai t result p1 q1 p2 q2;
startx = x;
/* initialize matrix */
m[0,0] = 1; m[1,1] = 1;
m[0,1] = 0; m[1,0] = 0;
/* loop finding terms until denom gets too big */
do while (1);
ai = x;
if not ( m[1,0] * ai + m[1,1] < maxden ) then leave;
t = m[0,0] * ai + m[0,1];
m[0,1] = m[0,0];
m[0,0] = t;
t = m[1,0] * ai + m[1,1];
m[1,1] = m[1,0];
m[1,0] = t;
if x = ai then leave; %* AF: division by zero;
x = 1 / (x - ai);
if x > 2147483647 /*x'7FFFFFFF'*/ then leave; %* AF: representation failure;
end;
/* now remaining x is between 0 and 1/ai */
/* approx as either 0 or 1/m where m is max that will fit in maxden */
/* first try zero */
p1 = m[0,0];
q1 = m[1,0];
e1 = startx - 1.0 * p1 / q1;
/* now try other possibility */
ai = (maxden - m[1,1]) / m[1,0];
m[0,0] = m[0,0] * ai + m[0,1];
m[1,0] = m[1,0] * ai + m[1,1];
p2 = m[0,0];
q2 = m[1,0];
e2 = startx - 1.0 * p2 / q2;
if abs(e1) <= abs(e2) then do;
p = p1;
q = q1;
end;
else do;
p = p2;
q = q2;
end;
return 0;
end;
endpackage;
run;
quit;
* Example uage;
proc ds2;
data _null_;
declare package math math();
declare double x;
declare int p1 q1 p q;
method run();
streaminit(12345);
x = 0;
do _n_ = 1 to 20;
p1 = ceil(rand('uniform',9));
q1 = ceil(rand('uniform',9));
x + 1. * p1 / q1;
math.rational (x, 10000, p, q);
put 'add' p1 '/' q1 ' ' x=best16. 'is' p '/' q;
end;
end;
enddata;
run;
quit;
----- LOG -----
add 4 / 1 x= 4 is 4 / 1
add 4 / 2 x= 6 is 6 / 1
add 2 / 7 x=6.28571428571429 is 44 / 7
add 4 / 6 x=6.95238095238095 is 146 / 21
add 5 / 2 x=9.45238095238095 is 397 / 42
add 5 / 2 x= 11.952380952381 is 251 / 21
add 7 / 1 x= 18.952380952381 is 398 / 21
add 8 / 6 x=20.2857142857143 is 142 / 7
add 9 / 3 x=23.2857142857143 is 163 / 7
add 8 / 2 x=27.2857142857143 is 191 / 7
add 3 / 1 x=30.2857142857143 is 212 / 7
add 9 / 3 x=33.2857142857143 is 233 / 7
add 4 / 3 x=34.6190476190476 is 727 / 21
add 4 / 6 x=35.2857142857143 is 247 / 7
add 1 / 9 x=35.3968253968254 is 2230 / 63
add 8 / 3 x=38.0634920634921 is 2398 / 63
add 2 / 4 x=38.5634920634921 is 4859 / 126
add 5 / 1 x=43.5634920634921 is 5489 / 126
add 1 / 2 x=44.0634920634921 is 2776 / 63
add 2 / 7 x=44.3492063492064 is 2794 / 63
DS2 math package

100mm to twips in LibreOffice

I have been reading some of the LibreOffice code, and there is code that converts from 100mm to twips.
Its basic formula is:
twips = (n>=0) ? (n*72+63) / 127 : (n*72-63) / 127;
Now I know that one twip is 1/20th of a point, and that one inch is 72 points, and 1 inch is 2.54cm, but I cannot work out how the above formula relates to these ratios!
Can anyone shed some light on this?
Putting together what OP provided:
n is the size in 100 mm.
1 inch is 2.54 cm is 25.4 mm.
inchs = n * 100 / 25.4
or inchs = n / (100 * 25.4)
or inchs = n / 2540
1 inch is 72 points.
points = inchs * 72
1 twip is 1/20th point.
twips = points / 20
Now, everything together:
twips = n / 2540 * 72 / 20
or twips = n * 72 / 2540 / 20
or twips = n * 72 / 127
If this is done in int arithmetic there will be truncation instead of mathematical rounding. This can be fixed by adding the half of 127 (127 / 2 = 63) to n * 72:
twips = (n * 72 + 63) / 127
This does not handle negative numbers correctly. For these, the 63 has to be subtracted instead:
twips = n >= 0 ? (n * 72 + 63) / 127) : (n * 72 - 63) / 127;
and here we are.
As already pointed out by Ron, the ?: operator is the ternary if-then-else operator.
An easier to read (but may be less optimized) replacement would be:
if (n >= 0) twips = (n * 72 + 63) / 127);
else twips = (n * 72 - 63) / 127;

How to convert 5 stars rating to pixels in python?

I have two different rates that the user can make for his teacher , i want to convert the total of each rate in pixels so i can have the progress bar effect, for example:
maximum_pixels = 100 #maximum width
services = 4.5 #width: 95px
professionalism = 5.0 #width: 100px
total_percentage = maximum_pixels * services / maximum_pixels
How can i implement that in my code ?
maxAllowed = 100
minAllowed = 0
unscaledNum = 3
_min = 0
_max = 5
((maxAllowed - minAllowed) * (unscaledNum - _min) / (_max - _min) + minAllowed)
Result:
60.0

calculate pixel coordinates for 8 equidistant points on a circle

I have a circle centred at 0 with radius 80. How using python do I calculate the coordinates for 8 equidistant points around the circumference of the circle?
r = 80
numPoints = 8.0
points = []
for index in range(numPoints):
points.append([r*math.cos((index*2*math.pi)/numPoints),r*math.sin((index*2*math.pi)/numPoints)])
return points
you can simplify this some if you know you are always going to have only 8 points with something like:
r = 80
numPoints = 8
points = []
x = (r*math.sqrt(2))/2
points = [[0,r],[x,x],[r,0],[-x,x],[-r,0],[-x,-x],[0,-r],[x,-x]]
print points
with x being the x/y of the point 45 degrees and 80 units away from the origin
click this pic for more clarity
in the above picture.
coordinates 1,2,3,4,5,6,7,8 are equidistant points on a circumference of circle Radius R and its centre is at X (0,0)
take the triangle XLZ , its aright angled at L ,
Let LZ = H ,
LY = A
XL + LY = R => XL + A = R => XL = R-A
since XLZ is right angled , XZ square = XL square + LZ square
R square = (R-A) square + h square ————1
since these 8 points makes an octagon theta = 360 deg / 8 = 45 deg
tan 45 deg = h / XL = h / R-A => 1 = h/ R-A => h = R-A —————2
Z coordinates are (R-A, h) = > (h,h)
from the equations 1 and 2
R square = h square + h square => 2 h square = R square => h = R/ sqrt 2
so the coordinates at point 2 (Z) = (R/sqrt2, R/sqrt2)
remaining can be derived easily as they are just oppside
So all coordinates are
1 (0,R)
2 (R/sqrt2,R/sqrt2)
3 (R,0)
4 (-R/sqrt2, R/sqrt2)
5 (-R,0)
6 (-R/sqrt2,-R/sqrt2)
7 (0,-R)
8 (R/sqrt2, -R/sqrt2)

Perspective and Bilinear transformations

I'm making a vector drawing application and noticed that Anti Grain Geometry have an example that does exactly what I want. http://www.antigrain.com/demo/index.html then below there is an example on perspective for Win32. I don't understand their cpp file. Based on this example. If I have a bunch of verticies to form an object, like their lion, and then I have 4 verticies as control points, how could I achieve their effect? Ex, what transformation do I apply to each point?
Thanks
From that very page you posted, there's a link to the source
code. I'll explain the bilinear transformation in
http://www.antigrain.com/__code/include/agg_trans_bilinear.h.html
The idea here is to find a transformation of the form:
output_x = a * input_x + b * input_x * input_y + c * input_y + d
output_y = e * input_x + f * input_x * input_y + g * input_y + h
The term "bilinear" comes from each of those equations being linear in
either of the input coordinates by themselves. We want to solve for
the right values of a, b, c, and d. Say you have the reference
rectangle r1, r2, r3, r4 which you want to map to (0,0), (1,0), (0,1),
(1,1) (or some image coordinate system).
For a,b,c,d:
0 = a * r1_x + b * r1_x * r1_y + c * r1_y + d
1 = a * r2_x + b * r2_x * r2_y + c * r2_y + d
0 = a * r3_x + b * r3_x * r3_y + c * r3_y + d
1 = a * r4_x + b * r4_x * r4_y + c * r4_y + d
For e,f,g,h:
0 = e * r1_x + f * r1_x * r1_y + g * r1_y + h
0 = e * r2_x + f * r2_x * r2_y + g * r2_y + h
1 = e * r3_x + f * r3_x * r3_y + g * r3_y + h
1 = e * r4_x + f * r4_x * r4_y + g * r4_y + h
You can solve this however you like best. (If you're familiar with
matrix notation, these are two matrix equations for which the matrix
is the same, and then you simply need to find the LU decomposition
once, and solve the two unknown vectors). The coefficients are then
applied to map the interior of the rectangle to the position in the
rectangle.
If by any chance you're looking for the inverse transform, that is,
if you want to know where a given pixel will land, you simply switch
inputs and outputs:
For a,b,c,d:
r1_x = a * 0 + b * 0 * 0 + c * 0 + d
r2_x = a * 1 + b * 1 * 0 + c * 0 + d
r3_x = a * 0 + b * 0 * 1 + c * 1 + d
r4_x = a * 1 + b * 1 * 1 + c * 1 + d
For e,f,g,h:
r1_y = e * 0 + f * 0 * 0 + g * 0 + h
r2_y = e * 1 + f * 1 * 0 + g * 0 + h
r3_y = e * 0 + f * 0 * 1 + g * 1 + h
r4_y = e * 0 + f * 0 * 1 + g * 1 + h
You're talking about perspective transformation from 2D planar onto a square 'in space' I think.
Well - This one is not that difficult. The mathematics are explained in the paper:
Heckbert, Paul, Fundamentals of
Texture Mapping and Image Warping,
Master’s thesis, UCB/CSD 89/516, CS
Division, U.C. Berkeley, June 1989.
(I don't link to the paper due to copyright reasons. It's available on the net and you shouldn't have any problems finding it though)
This gives you the math and some ready to use equations to do it.
If you are looking for some "easy to rip" code I suggest to download the OpenVG reference implementation and take a close look at the functions "vguComputeWarpQuadToSquare", "vguComputeWarpSquareToQuad" and "vguComputeWarpQuadToQuad" :-) They cover all you need.
Download here: http://www.khronos.org/registry/vg/ri/openvg-1.1-ri.zip
These functions will calculate a 3x3 matrix that does the transformation. To use this matrix you have to extend your 2D coordinates into 2D homogenous coordinates. That's not that difficult but beyond the scope of the question. If you need help to work with them I suggest that you ask that in a different question.