OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
linedge.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| linedge ../starter/source/groups/linedge.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_lines ../starter/source/groups/hm_read_lines.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE linedge(NSEG0 ,NSEG ,BUFTMP ,SLIN_NODES ,KEY,
31 . FLAG ,SLIN_ELTYP ,SLIN_ELEM,LINE_NSEG0)
32 USE names_and_titles_mod , ONLY : ncharkey
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER NSEG0,NSEG,FLAG,LINE_NSEG0
44 INTEGER BUFTMP(6,*),SLIN_NODES(LINE_NSEG0,*),SLIN_ELTYP(*),
45 . slin_elem(*)
46 CHARACTER(LEN=NCHARKEY) :: KEY
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I,J,K,J1,J2
51 INTEGER IW1(4*NSEG0),IW2(4*NSEG0),IW5(4*NSEG0),IW6(4*NSEG0),
52 . index(8*nseg0),iwork(70000), iperm(4)
53 DATA iperm /2,3,4,1/
54C=======================================================================
55 k=0
56 iw1 = 0
57 iw2 = 0
58 iw5 = 0
59 iw6 = 0
60 index = 0
61 DO i = 1,nseg0
62 DO j1=1,4
63 j2=iperm(j1)
64 IF(buftmp(j2,i)/=0.AND.
65 . buftmp(j1,i)>buftmp(j2,i))THEN
66 k=k+1
67 iw1(k)=buftmp(j2,i)
68 iw2(k)=buftmp(j1,i)
69 iw5(k)=buftmp(5,i)
70 iw6(k)=buftmp(6,i)
71 ELSEIF(buftmp(j1,i)/=0.AND.
72 . buftmp(j1,i)<buftmp(j2,i))THEN
73 k=k+1
74 iw1(k)=buftmp(j1,i)
75 iw2(k)=buftmp(j2,i)
76 iw5(k)=buftmp(5,i)
77 iw6(k)=buftmp(6,i)
78 ENDIF
79 ENDDO
80 ENDDO
81C-----------------------------------------------
82 CALL my_orders( 0,iwork,iw1,index,k,1)
83 CALL my_orders(10,iwork,iw2,index,k,1)
84C-----------------------------------------------
85 IF (key(1:4) == 'SURF') THEN
86C-----------------------------------------------
87C SUPPRESSION DES SEGMENTS DOUBLES
88C-----------------------------------------------
89 nseg=1
90 IF (flag == 0) THEN
91 DO i=2,k
92 IF(iw1(index(i-1))/=iw1(index(i)).OR.
93 . iw2(index(i-1))/=iw2(index(i))) nseg=nseg+1
94 ENDDO
95 ELSEIF (flag == 1) THEN
96 slin_nodes(1,1) = iw1(index(1))
97 slin_nodes(1,2) = iw2(index(1))
98 slin_eltyp(1) = iw5(index(1))
99 slin_elem(1) = iw6(index(1))
100 DO i=2,k
101 IF(iw1(index(i-1))/=iw1(index(i)).OR.
102 . iw2(index(i-1))/=iw2(index(i)))THEN
103 nseg=nseg+1
104 slin_nodes(nseg,1) = iw1(index(i))
105 slin_nodes(nseg,2) = iw2(index(i))
106 slin_eltyp(nseg) = iw5(index(i))
107 slin_elem(nseg) = iw6(index(i))
108 ENDIF
109 ENDDO
110 ENDIF ! IF (FLAG == 0)
111 ELSEIF (key(1:4) == 'EDGE') THEN
112C-----------------------------------------------
113C SUPPRESSION DES SEGMENTS INTERNES (SAUF BORDS)
114C-----------------------------------------------
115 nseg=0
116 IF (flag == 0) THEN
117 IF(iw1(index(1))/=iw1(index(2)).OR.
118 . iw2(index(1))/=iw2(index(2))) nseg=1
119 DO i=2,k-1
120 IF((iw1(index(i-1))/=iw1(index(i)).OR.
121 . iw2(index(i-1))/=iw2(index(i))).AND.
122 . (iw1(index(i+1))/=iw1(index(i)).OR.
123 . iw2(index(i+1))/=iw2(index(i)))) nseg=nseg+1
124 ENDDO
125 IF(iw1(index(k-1))/=iw1(index(k)).OR.
126 . iw2(index(k-1))/=iw2(index(k))) nseg=nseg+1
127C
128 ELSEIF (flag == 1) THEN
129 IF(iw1(index(1))/=iw1(index(2)).OR.
130 . iw2(index(1))/=iw2(index(2)))THEN
131 nseg=1
132 slin_nodes(nseg,1) = iw1(index(1))
133 slin_nodes(nseg,2) = iw2(index(1))
134 slin_eltyp(nseg) = iw5(index(1))
135 slin_elem(nseg) = iw6(index(1))
136 ENDIF
137 DO i=2,k-1
138 IF((iw1(index(i-1))/=iw1(index(i)).OR.
139 . iw2(index(i-1))/=iw2(index(i))).AND.
140 . (iw1(index(i+1))/=iw1(index(i)).OR.
141 . iw2(index(i+1))/=iw2(index(i))))THEN
142 nseg=nseg+1
143 slin_nodes(nseg,1) = iw1(index(i))
144 slin_nodes(nseg,2) = iw2(index(i))
145 slin_eltyp(nseg) = iw5(index(i))
146 slin_elem(nseg) = iw6(index(i))
147 ENDIF
148 ENDDO
149 IF(iw1(index(k-1))/=iw1(index(k)).OR.
150 . iw2(index(k-1))/=iw2(index(k)))THEN
151 nseg=nseg+1
152 slin_nodes(nseg,1) = iw1(index(k))
153 slin_nodes(nseg,2) = iw2(index(k))
154 slin_eltyp(nseg) = iw5(index(k))
155 slin_elem(nseg) = iw6(index(k))
156 ENDIF ! IF (FLAG == 0)
157 ENDIF ! IF (KEY(1:4) == 'SURF')
158C-----------
159 ENDIF
160C-----------
161 RETURN
162 END
linedge
subroutine linedge(nseg0, nseg, buftmp, slin_nodes, key, flag, slin_eltyp, slin_elem, line_nseg0)
Definition linedge.F:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000