1+ C ================================================================
2+ real Function sqrEdge (xy1 , xy2 )
3+ C ================================================================
4+ C Routine computes sqruare distance between two points
5+ C ================================================================
6+ real xy1(2 ), xy2(2 )
7+
8+ sqrEdge = (xy1(1 ) - xy2(1 )) ** 2 + (xy1(2 ) - xy2(2 )) ** 2
9+ Return
10+ End
11+
12+
13+ C ================================================================
14+ real Function calEdge (xy1 , xy2 )
15+ C ================================================================
16+ C Routine computes distance between two points
17+ C ================================================================
18+ real xy1(2 ), xy2(2 )
19+
20+ calEdge = sqrt ((xy1(1 ) - xy2(1 )) ** 2 +
21+ & (xy1(2 ) - xy2(2 )) ** 2 )
22+ Return
23+ End
24+
25+
26+
27+ C ================================================================
28+ real Function calNorm (xy1 )
29+ C ================================================================
30+ C Routine calculates norm of vector xy1
31+ C ================================================================
32+ real xy1(2 )
33+
34+ calNorm = sqrt (xy1(1 ) ** 2 + xy1(2 ) ** 2 )
35+ Return
36+ End
37+
38+
39+
40+ C ================================================================
41+ Subroutine extNormal (xy1 , xy2 , xy3 , xyn )
42+ C ================================================================
43+ C Routines compute external normal vector to the edge {xy1, xy2}
44+ C of triangle {xy1, xy2, xy3}
45+ C ================================================================
46+ real xy1(2 ), xy2(2 ), xy3(2 ), xyn(2 )
47+ real x, y, d
48+
49+ x = xy2(1 ) - xy1(1 )
50+ y = xy2(2 ) - xy1(2 )
51+
52+ d = sqrt (x * x + y * y)
53+
54+ xyn(1 ) = - y / d
55+ xyn(2 ) = x / d
56+
57+ c ... orientation
58+ x = xy3(1 ) - xy1(1 )
59+ y = xy3(2 ) - xy1(2 )
60+
61+ If ( x* xyn(1 ) + y* xyn(2 ).GT. 0D0 ) Then
62+ xyn(1 ) = - xyn(1 )
63+ xyn(2 ) = - xyn(2 )
64+ End if
65+
66+ Return
67+ End
68+
69+
70+ C ================================================================
71+ Subroutine calNormal (xy1 , xy2 , xyn )
72+ C ================================================================
73+ C Routines compute a normal vector to the edge {xy1, xy2}
74+ C ================================================================
75+ real xy1(2 ), xy2(2 ), xyn(2 )
76+ real x, y, d
77+
78+ x = xy2(1 ) - xy1(1 )
79+ y = xy2(2 ) - xy1(2 )
80+
81+ d = sqrt (x * x + y * y)
82+
83+ xyn(1 ) = - y / d
84+ xyn(2 ) = x / d
85+
86+ Return
87+ End
88+
89+
90+
91+ C ================================================================
92+ real Function DotMul (a , b )
93+ C ================================================================
94+ C Routine computes scalar product of two vectors
95+ C ================================================================
96+ real a(2 ), b(2 )
97+
98+ DotMul = a(1 ) * b(1 ) + a(2 ) * b(2 )
99+ Return
100+ End
101+
102+
103+
104+ C ================================================================
105+ real Function VecMul (a , b )
106+ C ================================================================
107+ C Routine computes vector product a x b which is a number in 2D.
108+ C ================================================================
109+ real a(2 ), b(2 )
110+
111+ VecMul = a(1 ) * b(2 ) - a(2 ) * b(1 )
112+ Return
113+ End
114+
115+
116+
117+ C ================================================================
118+ Logical Function check1j (i1 , j )
119+ C ================================================================
120+ C check1j = TRUE if i1 belongs to the set j(3).
121+ C ================================================================
122+ Integer j(3 )
123+
124+ check1j = .TRUE.
125+ If (i1.EQ. j(1 )) goto 1000
126+ If (i1.EQ. j(2 )) goto 1000
127+ If (i1.EQ. j(3 )) goto 1000
128+
129+ check1j = .FALSE.
130+ 1000 Return
131+ End
132+
133+
134+
135+ C ================================================================
136+ Logical Function check12 (i1 , j1 , j2 )
137+ C ================================================================
138+ C check12 = TRUE if i1 belongs to the set {j1, j2}.
139+ C ================================================================
140+ check12 = .TRUE.
141+ If (i1.EQ. j1) goto 1000
142+ If (i1.EQ. j2) goto 1000
143+
144+ check12 = .FALSE.
145+ 1000 Return
146+ End
147+
148+
149+ C ================================================================
150+ Logical Function check22 (i1 , i2 , j1 , j2 )
151+ C ================================================================
152+ C check22 = TRUE if pair {i1, i2} coinsides with {j1, j2}.
153+ C ================================================================
154+ check22 = .FALSE.
155+ If (i1.NE. j1 .AND. i1.NE. j2) goto 1000
156+ If (i2.NE. j1 .AND. i2.NE. j2) goto 1000
157+
158+ check22 = .TRUE.
159+ 1000 Return
160+ End
161+
162+
163+ C ================================================================
164+ Subroutine swapii (i1 , i2 )
165+ C ================================================================
166+ C Routine swaps two integers
167+ C ================================================================
168+ i = i1
169+ i1 = i2
170+ i2 = i
171+
172+ Return
173+ End
174+
175+
176+
177+ C ================================================================
178+ Subroutine swapdd (d1 , d2 )
179+ C ================================================================
180+ C Routine swaps two real numbers
181+ C ================================================================
182+ real d, d1, d2
183+ d = d1
184+ d1 = d2
185+ d2 = d
186+
187+ Return
188+ End
189+
190+
191+ C ================================================================
192+ Subroutine paramInclude (d1 , d2 )
193+ C ================================================================
194+ C Dummy function to test includes on hover
195+ C ================================================================
196+ include " parameters.prm"
197+ real d, d1, d2
198+ d = AniRatio
199+ d1 = AniEigenvalue
200+ d2 = DiscreteGrad
201+
202+ Return
203+ End
0 commit comments