OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sort_surf.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!|| sort_surf ../starter/source/groups/sort_surf.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE sort_surf(IGRSURF,IXS,IXC,IXTG,IXQ,IXP,IXR,IXT,KXX,NIXX)
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE groupdef_mod
35 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg,nixtg
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER,INTENT(IN) :: NIXX !< array size
49 INTEGER,INTENT(IN) :: IXS(NIXS,NUMELS) !< elem buffer for /BRIC entities
50 INTEGER,INTENT(IN) :: IXC(NIXC,NUMELC) !< elem buffer for /SHELL entities
51 INTEGER,INTENT(IN) :: IXTG(NIXTG,NUMELTG) !< elem buffer for /SH3N (3d) or /TRIA (2d) entities
52 INTEGER,INTENT(IN) :: IXQ(NIXQ,NUMELQ) !< elem buffer for /QUAD entities
53 INTEGER,INTENT(IN) :: IXP(NIXP,NUMELP) !< elem buffer for /BEAM entities
54 INTEGER,INTENT(IN) :: IXR(NIXR,NUMELR) !< elem buffer for /SPRING entities
55 INTEGER,INTENT(IN) :: IXT(NIXT,NUMELT) !< elem buffer for /TRUSS entities
56 INTEGER,INTENT(IN) :: KXX(NIXX,NUMELX) !< elem buffer for /XELEM entities
57 TYPE(surf_),INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF !< data structure for surfaces
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, NN, ELEM, ITYP, K, IT
62 INTEGER, DIMENSION(:), ALLOCATABLE :: IBUFSSG_TRI,IWORK,INDEX
63 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI
64C-----------------------------------------------
65C S o u r c e L i n e s
66C-----------------------------------------------
67 ALLOCATE (iwork(80000))
68
69 DO k=1,nsurf
70 nn = igrsurf(k)%NSEG
71
72 ALLOCATE (ibufssg_tri(nisx*nn))
73 ALLOCATE (itri(2,nn))
74 ALLOCATE (index(3*nn))
75
76 DO i=1,nn
77 ibufssg_tri(6*(i-1)+1) = igrsurf(k)%NODES(i,1)
78 ibufssg_tri(6*(i-1)+2) = igrsurf(k)%NODES(i,2)
79 ibufssg_tri(6*(i-1)+3) = igrsurf(k)%NODES(i,3)
80 ibufssg_tri(6*(i-1)+4) = igrsurf(k)%NODES(i,4)
81 ibufssg_tri(6*(i-1)+5) = igrsurf(k)%ELTYP(i)
82 ibufssg_tri(6*(i-1)+6) = igrsurf(k)%ELEM(i)
83
84 elem = igrsurf(k)%ELEM(i)
85 ityp = igrsurf(k)%ELTYP(i)
86 ! ITYP = 0 - surf of segments
87 ! ITYP = 1 - surf of solids
88 ! ITYP = 2 - surf of quads
89 ! ITYP = 3 - surf of SH4N
90 ! ITYP = 4 - line of trusses
91 ! ITYP = 5 - line of beams
92 ! ITYP = 6 - line of springs
93 ! ITYP = 7 - surf of SH3N
94 ! ITYP = 8 - line of XELEM (nstrand element)
95 ! ITYP = 101 - ISOGEOMETRIC
96
97 itri(1,i) = ityp
98 itri(2,i) = 0
99
100 SELECT CASE (ityp)
101 CASE ( 0 )
102 itri(2,i) = 0
103 CASE ( 1 )
104 itri(2,i) = ixs(nixs,elem)
105 CASE ( 2 )
106 itri(2,i) = ixq(nixq,elem)
107 CASE ( 3 )
108 itri(2,i) = ixc(nixc,elem)
109 CASE ( 4 )
110 itri(2,i) = ixt(nixt,elem)
111 CASE ( 5 )
112 itri(2,i) = ixp(nixp,elem)
113 CASE ( 6 )
114 itri(2,i) = ixr(nixr,elem)
115 CASE ( 7 )
116 itri(2,i) = ixtg(nixtg,elem)
117 CASE ( 8 )
118 itri(2,i) = kxx(nixx,elem)
119 END SELECT
120
121 index(i) = i
122
123 ENDDO ! next NN
124
125 CALL my_orders(0,iwork,itri,index,nn,2)
126
127 DO i=1,nn
128 it = index(i)
129 igrsurf(k)%NODES(i,1) = ibufssg_tri(6*(it-1)+1)
130 igrsurf(k)%NODES(i,2) = ibufssg_tri(6*(it-1)+2)
131 igrsurf(k)%NODES(i,3) = ibufssg_tri(6*(it-1)+3)
132 igrsurf(k)%NODES(i,4) = ibufssg_tri(6*(it-1)+4)
133 igrsurf(k)%ELTYP(i) = ibufssg_tri(6*(it-1)+5)
134 igrsurf(k)%ELEM(i) = ibufssg_tri(6*(it-1)+6)
135 ENDDO
136
137 DEALLOCATE(ibufssg_tri)
138 DEALLOCATE(itri)
139 DEALLOCATE(index)
140
141 ENDDO ! DO K=1,NSURF
142!---
143 RETURN
144 END
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
subroutine sort_surf(igrsurf, ixs, ixc, ixtg, ixq, ixp, ixr, ixt, kxx, nixx)
Definition sort_surf.F:31