OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_line_from_surface_all.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!|| create_line_from_surface_all ../starter/source/model/sets/create_line_from_surface_all.F
25!||--- calls -----------------------------------------------------
26!||--- uses -----------------------------------------------------
27!|| message_mod ../starter/share/message_module/message_mod.F
28!||====================================================================
29 SUBROUTINE create_line_from_surface_all(CLAUSE)
30C-----------------------------------------------
31C M o d u l e s
32C-----------------------------------------------
33 USE my_alloc_mod
34 USE message_mod
35 USE setdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER OPT_A,SET_ID,ELTYP
44 TYPE (SET_) :: CLAUSE
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48 INTEGER I,K,J1,J2,SIZEMAX,NSEG,IEXT,NSEG_EDGE_EXT,
49 . NSEG_EDGE_ALL,NSEG_SURF,LINE_NENTITY
50 INTEGER IWORK(70000),IPERM(4)
51!
52 DATA iperm /2,3,4,1/
53!
54 INTEGER , DIMENSION(:),ALLOCATABLE :: INDEX,IW1,IW2,IW5,IW6
55 INTEGER , DIMENSION(:,:),ALLOCATABLE :: ITRI,LINE_ORD
56C=======================================================================
57 sizemax = clause%NB_LINE_SEG + 4*clause%NB_SURF_SEG
58
59 IF (sizemax == 0) RETURN
60
61!
62 line_nentity = 4 ! NOD1, NOD2, ELTYP, ELEM
63 ALLOCATE(line_ord(line_nentity,sizemax))
64 ALLOCATE(itri(3,sizemax))
65 ALLOCATE(index(2*sizemax))
66!
67 ALLOCATE(iw1(4*sizemax))
68 ALLOCATE(iw2(4*sizemax))
69 ALLOCATE(iw5(4*sizemax))
70 ALLOCATE(iw6(4*sizemax))
71!------------------
72 ! NSEG of lines initialization
73 nseg = clause%NB_LINE_SEG ! lines from 1D_element
74! Fill in LINE_ORD array the already stored line from 1D_element
75 DO i=1,nseg
76 line_ord(1,i) = clause%LINE_NODES(i,1)
77 line_ord(2,i) = clause%LINE_NODES(i,2)
78 line_ord(3,i) = clause%LINE_ELTYP(i)
79 line_ord(4,i) = clause%LINE_ELEM(i)
80 ENDDO
81!
82! extract lines from furfaces
83!
84 nseg_surf = clause%NB_SURF_SEG
85 IF (nseg_surf > 0) THEN
86!***********************************
87!***********************************
88 ! -- ALL -- edges form SURFACE
89!***********************************
90!***********************************
91 nseg_edge_all = 0
92!---
93 k=0
94 iw1 = 0
95 iw2 = 0
96 iw5 = 0
97 iw6 = 0
98 DO i = 1,nseg_surf
99 DO j1=1,4
100 j2=iperm(j1)
101 IF (clause%SURF_NODES(i,j2) /= 0 .AND.
102 . clause%SURF_NODES(i,j1) > clause%SURF_NODES(i,j2)) THEN
103 k=k+1
104 iw1(k)=clause%SURF_NODES(i,j2)
105 iw2(k)=clause%SURF_NODES(i,j1)
106 iw5(k)=clause%SURF_ELTYP(i)
107 iw6(k)=clause%SURF_ELEM(i)
108 ELSEIF (clause%SURF_NODES(i,j1) /= 0 .AND.
109 . clause%SURF_NODES(i,j1) < clause%SURF_NODES(i,j2)) THEN
110 k=k+1
111 iw1(k)=clause%SURF_NODES(i,j1)
112 iw2(k)=clause%SURF_NODES(i,j2)
113 iw5(k)=clause%SURF_ELTYP(i)
114 iw6(k)=clause%SURF_ELEM(i)
115 ENDIF
116 ENDDO
117 ENDDO ! DO I = 1,NSEG_SURF
118!
119 nseg_edge_all = k
120C-----------------------------------------------
121 index = 0
122 iwork(1:70000) = 0
123 CALL my_orders( 0,iwork,iw1,index,k,1)
124 iwork(1:70000) = 0
125 CALL my_orders(10,iwork,iw2,index,k,1)
126!---
127 IF (nseg_edge_all > 0) THEN
128C-----------------------------------------------
129C REMOVE DOUBLE SEGMENTS
130C-----------------------------------------------
131 nseg = nseg + 1
132 line_ord(1,nseg) = iw1(index(1))
133 line_ord(2,nseg) = iw2(index(1))
134 line_ord(3,nseg) = iw5(index(1))
135 line_ord(4,nseg) = iw6(index(1))
136 DO i=2,k
137 IF (iw1(index(i-1)) /= iw1(index(i)).OR.
138 . iw2(index(i-1)) /= iw2(index(i))) THEN
139 nseg = nseg + 1
140 line_ord(1,nseg) = iw1(index(i))
141 line_ord(2,nseg) = iw2(index(i))
142 line_ord(3,nseg) = iw5(index(i))
143 line_ord(4,nseg) = iw6(index(i))
144 ENDIF
145 ENDDO
146 ENDIF ! IF (NSEG_EDGE_ALL > 0)
147 ENDIF ! IF (NSEG_SURF > 0)
148!------------------------------------------
149!------------------------------------------
150! ORDER LINES and LINE CLAUSE FILLING
151!------------------------------------------
152!------------------------------------------
153 index = 0
154 iwork(1:70000) = 0
155 DO i=1,nseg
156 index(i)=i
157 itri(1,i) = line_ord(1,i)
158 itri(2,i) = line_ord(2,i)
159 itri(3,i) = line_ord(4,i) ! elem_id
160 ENDDO
161 CALL my_orders(0,iwork,itri,index,nseg,3)
162!
163 ! reallocation of the line CLAUSE at the right dimension and final fill
164!
165 IF (ALLOCATED(clause%LINE_NODES)) DEALLOCATE(clause%LINE_NODES)
166 IF (ALLOCATED(clause%LINE_ELTYP)) DEALLOCATE(clause%LINE_ELTYP)
167 IF (ALLOCATED(clause%LINE_ELEM)) DEALLOCATE(clause%LINE_ELEM)
168!
169 clause%NB_LINE_SEG = nseg
170 CALL my_alloc(clause%LINE_NODES,nseg,2)
171 CALL my_alloc(clause%LINE_ELTYP,nseg)
172 CALL my_alloc(clause%LINE_ELEM,nseg)
173!
174 DO i=1,nseg
175 clause%LINE_NODES(i,1) = line_ord(1,index(i))
176 clause%LINE_NODES(i,2) = line_ord(2,index(i))
177 clause%LINE_ELTYP(i) = line_ord(3,index(i))
178 clause%LINE_ELEM(i) = line_ord(4,index(i))
179 ENDDO
180!---
181 IF (ALLOCATED(line_ord)) DEALLOCATE(line_ord)
182 IF (ALLOCATED(itri)) DEALLOCATE(itri)
183 IF (ALLOCATED(index)) DEALLOCATE(index)
184 IF (ALLOCATED(iw1)) DEALLOCATE(iw1)
185 IF (ALLOCATED(iw2)) DEALLOCATE(iw2)
186 IF (ALLOCATED(iw5)) DEALLOCATE(iw5)
187 IF (ALLOCATED(iw6)) DEALLOCATE(iw6)
188C-----------
189 RETURN
190 END
create_line_from_surface_all
subroutine create_line_from_surface_all(clause)
Definition create_line_from_surface_all.F:30
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
setdef_mod
Definition setdef_mod.F:107