OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
init_th_group.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!|| init_th_group ../engine/source/output/th/init_th_group.F
25!||--- called by ------------------------------------------------------
26!|| resol_init ../engine/source/engine/resol_init.F
27!||--- uses -----------------------------------------------------
28!|| groupdef_mod ../common_source/modules/groupdef_mod.F
29!||====================================================================
30 SUBROUTINE init_th_group(GR ,IGR ,NELEM ,NGRTH ,IPARG ,
31 . IPART ,IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N,
32 . IGRTRUSS ,IGRBEAM ,IGRSPRING)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE groupdef_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "com01_c.inc"
46#include "param_c.inc"
47#include "scr17_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IGR(*),GR(*),NELEM,NGRTH,
52 . IPARG(NPARG,*),IPART(LIPART1,*)
53C-----------------------------------------------
54 TYPE (GROUP_) , TARGET, DIMENSION(NGRBRIC) :: IGRBRIC
55 TYPE (GROUP_) , TARGET, DIMENSION(NGRQUAD) :: IGRQUAD
56 TYPE (group_) , TARGET, DIMENSION(NGRSHEL) :: igrsh4n
57 TYPE (group_) , TARGET, DIMENSION(NGRSH3N) :: igrsh3n
58 TYPE (group_) , TARGET, DIMENSION(NGRTRUS) :: igrtruss
59 TYPE (GROUP_) , TARGET, DIMENSION(NGRBEAM) :: IGRBEAM
60 TYPE (GROUP_) , TARGET, DIMENSION(NGRSPRI) :: IGRSPRING
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,J,K,ID,NN,NVAR,ITYP,CPT,GRTMP,IGRTMP(NGRTH+NELEM),
65 . IGR1,FLAG,OFFSET,NG,CPT1,IGRELE,NENTITY
66 INTEGER :: NEL,NFT
67 INTEGER, DIMENSION(:), POINTER :: ELEM
68C-----------------------------------------------
69 cpt = 1
70 igrtmp = 0
71 offset = 0
72 cpt1 = 0
73 DO k=npart+1,npart+nthpart
74 i = ipart(1,k)
75 cpt1 = cpt1 + 1
76!---
77 offset = 0
78 igrele = ipart(1,k)
79 ityp = ipart(2,k)
80 id = ipart(4,k)
81 nentity = 0
82!
83 IF (ityp == 1) THEN ! brick group of thpart
84 nentity = igrbric(igrele)%NENTITY
85 elem => igrbric(igrele)%ENTITY
86 ELSEIF (ityp == 2) THEN ! quad group of thpart
87 offset = offset + numels
88 nentity = igrquad(igrele)%NENTITY
89 elem => igrquad(igrele)%ENTITY
90 ELSEIF (ityp == 3) THEN ! sh4n group of thpart
91 offset = offset + numelq
92 nentity = igrsh4n(igrele)%NENTITY
93 elem => igrsh4n(igrele)%ENTITY
94 ELSEIF (ityp == 4) THEN ! truss group of thpart
95 offset = offset + numelc
96 nentity = igrtruss(igrele)%NENTITY
97 elem => igrtruss(igrele)%ENTITY
98 ELSEIF (ityp == 5) THEN ! beam group of thpart
99 offset = offset + numelt
100 nentity = igrbeam(igrele)%NENTITY
101 elem => igrbeam(igrele)%ENTITY
102 ELSEIF (ityp == 6) THEN ! spring group of thpart
103 offset = offset + numelp
104 nentity = igrspring(igrele)%NENTITY
105 elem => igrspring(igrele)%ENTITY
106 ELSEIF (ityp == 7) THEN ! SH3N group of thpart
107 offset = offset + numelr
108 nentity = igrsh3n(igrele)%NENTITY
109 elem => igrsh3n(igrele)%ENTITY
110 ENDIF ! IF (ITYP == 1)
111!---
112 DO j=1,nentity
113 igrtmp(cpt) = elem(j)+offset
114 gr(cpt) = cpt1
115 igr(elem(j)+offset) = igr(elem(j)+offset) + 1
116 cpt = cpt + 1
117 ENDDO ! DO J=1,NENTITY
118 ENDDO ! DO K=NPART+1,NPART+NTHPART
119!
120 DO i=1,cpt-1
121 DO j=i,cpt-1
122 IF (igrtmp(i) > igrtmp(j)) THEN
123 grtmp = gr(j)
124 gr(j) = gr(i)
125 gr(i) = grtmp
126 grtmp = igrtmp(j)
127 igrtmp(j)= igrtmp(i)
128 igrtmp(i) = grtmp
129 ENDIF
130 ENDDO
131 ENDDO
132!
133 igrtmp = 0
134 DO i = 1,nelem
135 igrtmp(i) = igr(i)
136 ENDDO
137!
138 flag = 0
139 IF (igr(1) == 0) THEN
140 igr(1) = 1
141 ELSE
142 igr(2) = 1 + igr(1)
143 igr(1) = 1
144 flag = 1
145 ENDIF
146!
147 DO i = 2,nelem
148 IF (igr(i) == 0) THEN
149 IF (flag == 0) THEN
150 igr(i) = igr(i-1)
151 ELSEIF (flag == 1) THEN
152 igr(i) = igr(i)
153 flag = 0
154 ENDIF
155 ELSE
156 IF (flag == 0) THEN
157 igr(i) = igr(i-1)
158 igr(i+1) = igr(i) + igrtmp(i)
159 ELSEIF (flag == 1) THEN
160 igr(i) = igr(i)
161 igr(i+1) = igr(i) + igrtmp(i)
162 ENDIF
163 flag = 1
164 ENDIF
165 ENDDO
166!
167 DO ng=1,ngroup
168 nel = iparg(2,ng)
169 nft = iparg(3,ng)
170 ityp = iparg(5,ng)
171 IF (ityp == 1) offset = 0
172 IF (ityp == 2) offset = numels
173 IF (ityp == 3) offset = numels + numelq
174 IF (ityp == 4) offset = numels + numelq + numelc
175 IF (ityp == 5) offset = numels + numelq + numelc
176 . + numelt
177 IF (ityp == 6) offset = numels + numelq + numelc
178 . + numelt + numelp
179 IF (ityp == 7) offset = numels + numelq + numelc
180 . + numelt + numelp + numelr
181 DO j=nft+offset+1,nft+offset+nel
182 IF (igr(j) /= igr(j+1)) THEN
183 iparg(51,ng) = 1
184 ENDIF
185 ENDDO
186 ENDDO
187!---
188 RETURN
189 END
init_th_group
subroutine init_th_group(gr, igr, nelem, ngrth, iparg, ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
Definition init_th_group.F:33
groupdef_mod
Definition groupdef_mod.F:662
groupdef_mod::group_
Definition groupdef_mod.F:700