← Back to branch summary

~fluidity-core/fluidity/embedded_models

« back to all changes in this revision

Viewing changes to libmba2d/untangle.f

  • Committer: Timothy Bond
  • Date: 2011-04-14 15:40:24 UTC
  • Revision ID: timothy.bond@imperial.ac.uk-20110414154024-116ci9gq6mwigmaw
Following the move from svn to bzr we change the nature of inclusion of these
four software libraries. Previously, they were included as svn externals and
pulled at latest version for trunk, pinned to specific versions for release
and stable trunk. Since bzr is less elegant at dealing with externals we have
made the decision to include the packages directly into the trunk instead.

At this import the versions are:

libadaptivity: r163
libvtkfortran: r67
libspud: r545
libmba2d: r28

Show diffs side-by-side

added added

removed removed

Lines of Context:
libmba2d/untangle.f
 
1
C ================================================================
 
2
      Subroutine updQa(n, XYP, IPE, IEE, qE)
 
3
C ================================================================
 
4
C Initial quality modification for tangled elements and their 
 
5
C edge-neighboors.
 
6
C ================================================================
 
7
      real  XYP(2, *), qE(*)
 
8
      Integer IPE(3, *), IEE(3, *)
 
9
 
 
10
C (Local variables)
 
11
      Integer ip(4)
 
12
      real  calVol, v1, v2
 
13
      Logical check22
 
14
 
 
15
C ================================================================
 
16
      ip(1) = 1
 
17
      ip(2) = 2
 
18
      ip(3) = 3
 
19
      ip(4) = 1
 
20
 
 
21
      Do 100 i1 = 1, 3
 
22
         iE = IEE(i1, n)
 
23
         If(iE.LE.0) goto 100
 
24
 
 
25
         i2 = ip(i1 + 1)
 
26
         i3 = ip(i2 + 1)
 
27
 
 
28
         iP1 = IPE(i1, n)
 
29
         iP2 = IPE(i2, n)
 
30
 
 
31
         Do j1 = 1, 3
 
32
            j2 = ip(j1 + 1)
 
33
 
 
34
            jP1 = IPE(j1, iE)
 
35
            jP2 = IPE(j2, iE)
 
36
 
 
37
            If(check22(iP1, iP2, jP1, jP2)) Then
 
38
               i3  = ip(i2 + 1)
 
39
               iP3 = IPE(i3, n)
 
40
 
 
41
               j3  = ip(j2 + 1)
 
42
               jP3 = IPE(j3, iE)
 
43
 
 
44
               v1 = calVol(XYP(1, iP1), XYP(1, iP2), XYP(1, iP3))
 
45
               v2 = calVol(XYP(1, iP1), XYP(1, iP2), XYP(1, jP3))
 
46
 
 
47
               If(v1 * v2.GE.0D0) Then
 
48
                  qE(n)  = -abs(qE(n))
 
49
                  qE(iE) = -abs(qE(iE))
 
50
               End if
 
51
               goto 100
 
52
            End if
 
53
         End do
 
54
 100  Continue
 
55
 
 
56
      Return
 
57
      End
 
58
 
 
59
 
 
60
C ================================================================
 
61
      Subroutine updQb(nEs, lE, iEs, XYP, IPEs, qEs)
 
62
C ================================================================
 
63
C Dynamic quality modification for tangled elements inside
 
64
C a super-element.
 
65
C
 
66
C Remark: non-efficient, time-consuming, but robust algorithm.
 
67
C ================================================================
 
68
      real  XYP(2, *), qEs(*)
 
69
      Integer iEs(*), IPEs(3, *)
 
70
 
 
71
C group (Local variables)
 
72
      Integer ip(4)
 
73
      real  calVol, v1, v2
 
74
      Logical check22
 
75
 
 
76
C ================================================================
 
77
      ip(1) = 1
 
78
      ip(2) = 2
 
79
      ip(3) = 3
 
80
      ip(4) = 1
 
81
 
 
82
      Do 100 i1 = 1, 3
 
83
         i2 = ip(i1 + 1)
 
84
 
 
85
         iP1 = IPEs(i1, nEs)
 
86
         iP2 = IPEs(i2, nEs)
 
87
 
 
88
         Do 20 k = 1, lE
 
89
            If(iEs(k).LT.0)  goto 20
 
90
            If(k.EQ.nEs)     goto 20
 
91
 
 
92
            Do j1 = 1, 3
 
93
               j2 = ip(j1 + 1)
 
94
 
 
95
               jP1 = IPEs(j1, k)
 
96
               jP2 = IPEs(j2, k)
 
97
 
 
98
               If(check22(iP1, iP2, jP1, jP2)) Then
 
99
                  i3  = ip(i2 + 1)
 
100
                  iP3 = IPEs(i3, nEs)
 
101
 
 
102
                  j3  = ip(j2 + 1)
 
103
                  jP3 = IPEs(j3, k)
 
104
 
 
105
                  v1 = calVol(XYP(1, iP1), XYP(1, iP2), XYP(1, iP3))
 
106
                  v2 = calVol(XYP(1, iP1), XYP(1, iP2), XYP(1, jP3))
 
107
 
 
108
                  If(v1 * v2.GE.0D0) Then
 
109
                     qEs(nEs) = -abs(qEs(nEs))
 
110
                     qEs(k)   = -abs(qEs(k))
 
111
                  End if
 
112
 
 
113
                  goto 100
 
114
               End if
 
115
            End do
 
116
 20      Continue
 
117
 100  Continue
 
118
 
 
119
 1000 Return
 
120
      End
 
121
 
 
122
 
 
123
 
 
124
C ================================================================
 
125
      Logical Function  chkTangled(lE, iEs, IPEs)
 
126
C ================================================================
 
127
C Local mesh modifications for tangled mesh may result is a 
 
128
C topologically wrong mesh (chkTangled = TRUE).
 
129
C ================================================================
 
130
      Integer iEs(*), IPEs(3, *)
 
131
 
 
132
C group (Local variables)
 
133
      Integer ip(4), tEdge
 
134
      Logical check22
 
135
 
 
136
C ================================================================
 
137
      chkTangled = .TRUE.
 
138
 
 
139
      ip(1) = 1
 
140
      ip(2) = 2
 
141
      ip(3) = 3
 
142
      ip(4) = 1
 
143
 
 
144
c ...  more than two triangles with a common edge
 
145
       Do 20 n = 1, lE
 
146
          iEt = iEs(n)
 
147
          If(iEt.LE.0) goto 20
 
148
          
 
149
          tEdge = 0
 
150
          Do i1 = 1, 3
 
151
             i2 = ip(i1 + 1)
 
152
 
 
153
             iP1 = IPEs(i1, n)
 
154
             iP2 = IPEs(i2, n)
 
155
 
 
156
             nEdge = 0
 
157
             Do 10 m = 1, lE
 
158
                jEt = iEs(m)
 
159
                If(m.EQ.n .OR. jEt.LE.0) goto 10
 
160
 
 
161
                Do j1 = 1, 3
 
162
                   j2 = ip(j1 + 1)
 
163
 
 
164
                   jP1 = IPEs(j1, m)
 
165
                   jP2 = IPEs(j2, m)
 
166
                   If(check22(iP1, iP2, jP1, jP2)) nEdge = nEdge + 1
 
167
                End do
 
168
 10          Continue            
 
169
             If(nEdge.GT.2) goto 1000
 
170
             tEdge = tEdge + nEdge
 
171
          End do 
 
172
 
 
173
c  ...  no neighboors
 
174
          If(tEdge.EQ.0) goto 1000
 
175
 20    Continue
 
176
       
 
177
 
 
178
c ...  there is no topological defects
 
179
       chkTangled = .FALSE.
 
180
 
 
181
 1000  Return
 
182
       End
 
183