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