OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgrhead.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!|| rgrhead ../starter/source/elements/spring/rgrhead.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| cluster_mod ../starter/share/modules1/cluster_mod.F
30!||====================================================================
31 SUBROUTINE rgrhead(
32 1 IXR ,GEO ,INUM ,ISEL ,IGEO ,
33 2 ITR1 ,EADD ,INDEX ,ITRI ,
34 3 IPARTR ,ND ,IGRSURF,IGRSPRING,
35 4 CEP ,XEP ,IRESOFF,TAGPRT_SMS, CLUSTERS,
36 5 IPM ,R_SKEW ,ITAGPRLD_SPRING)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE groupdef_mod
41 USE cluster_mod
42 USE seatbelt_mod
43 use element_mod , only : nixr
44C-----------------------------------------------
45C A R G U M E N T S
46C-----------------------------------------------
47C IXR(6,NUMELR) CONNECTIVITY+PID+SPRING NUMBERS TABLE E
48C geo(npropG,numgeo)table of characteristics of pid
49C INUM(6,NUMELR) WORK TABLE E/S
50C ISEL(NSELR) TABLE OF SPRINGS CHOSEN FOR TH E/S
51C ITR1(NSELR) WORK TABLE E/S
52C EADD(NUMELR) TABLE OF ADDRESSES IN IDAM CHGT DAMIER S
53C INDEX(NUMELR) WORK TABLE E/S
54C ITRI(4,NUMELR) WORK TABLE E/S
55C IPARTR(NUMELR) PART TABLE E/S
56C CEP(NUMELR) PROC TABLE E/S
57C XEP(NUMELR) PROC TABLE E/S
58C-----------------------------------------------
59C I M P L I C I T T Y P E S
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C O M M O N B L O C K S
64C-----------------------------------------------
65#include "vect01_c.inc"
66#include "com04_c.inc"
67#include "param_c.inc"
68#include "sms_c.inc"
69C-----------------------------------------------
70C D U M M Y A R G U M E N T S
71C-----------------------------------------------
72 INTEGER IXR(NIXR,*),ISEL(*),INUM(9,*),IPARTR(*),
73 . EADD(*),ITR1(*),INDEX(*),ITRI(5,*),
74 . ND, CEP(*), XEP(*),IRESOFF(*),R_SKEW(*),
75 . TAGPRT_SMS(*), IGEO(NPROPGI,*),IPM(NPROPMI,*)
76 my_real :: GEO(NPROPG,*)
77 INTEGER ,INTENT(INOUT), DIMENSION(NUMELR) ::ITAGPRLD_SPRING
78C-----------------------------------------------
79 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
80 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
81 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
82C-----------------------------------------------
83C L O C A L V A R I A B L E S
84C-----------------------------------------------
85 INTEGER
86 . i,j,k, issn, nn, mid, pid ,igtyp,
87 . ii,jj,ii2,jj2,ii3,jj3,ii4,jj4,ii5,jj5,
88 . iflag_gtyp,iprld,
89 . mskmtn,mskisn,mskpid, mode, work(70000)
90 EXTERNAL my_shiftl,my_shiftr,my_and
91 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
92 INTEGER :: CLUSTER_TYP,CLUSTER_NEL
93 INTEGER, DIMENSION(:), ALLOCATABLE :: SAVE_CLUSTER
94
95C
96 DATA mskmtn /o'07770000000'/
97 DATA mskisn /o'00000000700'/
98 DATA mskpid /o'07777777777'/
99C
100C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
101
102C----------------------------------------------------------
103C global sorting on all criteria for all elements
104C----------------------------------------------------------
105C
106 DO i=1,numelr
107 eadd(i)=1
108 itri(5,i)=i
109 index(i)=i
110 inum(1,i)=ipartr(i)
111 inum(2,i)=ixr(1,i)
112 inum(3,i)=ixr(2,i)
113 inum(4,i)=ixr(3,i)
114 inum(5,i)=ixr(4,i)
115 inum(6,i)=ixr(5,i)
116 inum(7,i)=ixr(6,i)
117 inum(8,i)=iresoff(i)
118 inum(9,i)=r_skew(i)
119 ENDDO
120
121 DO i=1,numelr
122 xep(i)=cep(i)
123 ENDDO
124
125 DO i = 1, numelr
126 ii = i
127 pid = ixr(1,ii)
128 mid = ixr(5,ii)
129 mtn = nint(geo(8,pid))
130 issn = 0
131 IF(geo(5,pid)/=zero) issn=1
132 igtyp = igeo(11,pid)
133 iflag_gtyp = 0
134 IF(igtyp == 23)THEN
135 iflag_gtyp = 1
136 mtn = ipm(2,mid)
137 ENDIF
138 iprld = itagprld_spring(ii)
139 IF (iprld>0) iflag_gtyp = 1+iprld
140C
141 jsms = 0
142 IF(isms/=0)THEN
143 IF(idtgrs/=0)THEN
144 IF(tagprt_sms(ipartr(ii))/=0)jsms=1
145 ELSE
146 jsms=1
147 END IF
148 END IF
149C JSMS=MY_SHIFTL(JSMS,0)
150C NEXT=MY_SHIFTL(NEXT,1)
151 issn=my_shiftl(issn,6)
152 mtn=my_shiftl(mtn,21)
153C
154 itri(1,i)=jsms + issn + mtn
155
156 itri(2,i)=pid
157C
158 itri(3,i)=iresoff(i)
159C
160 itri(4,i)=iflag_gtyp
161C
162 itri(5,i)=mid
163 ENDDO
164C
165 mode=0
166 CALL my_orders( mode, work, itri, index, numelr , 5)
167C
168 DO i=1,numelr
169 ipartr(i) =inum(1,index(i))
170 iresoff(i)=inum(8,index(i))
171 r_skew(i)=inum(9,index(i))
172 ENDDO
173
174 DO i=1,numelr
175 cep(i)=xep(index(i))
176 ENDDO
177
178 DO k=1,6
179 DO i=1,numelr
180 ixr(k,i)=inum(k+1,index(i))
181 ENDDO
182 ENDDO
183C
184C inversion of index (in itr1)
185C
186 DO i=1,numelr
187 itr1(index(i))=i
188 ENDDO
189C
190C renumbering for surfaces
191C
192 DO i=1,nsurf
193 nn=igrsurf(i)%NSEG
194 DO j=1,nn
195 IF(igrsurf(i)%ELTYP(j) == 6)
196 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
197 ENDDO
198 ENDDO
199C
200C renumbering for spring groups
201C
202 DO i=1,ngrspri
203 nn=igrspring(i)%NENTITY
204 DO j=1,nn
205 igrspring(i)%ENTITY(j) = itr1(igrspring(i)%ENTITY(j))
206 ENDDO
207 ENDDO
208
209! -----------------------
210! reordering for cluster typ=2 or 3 (spring cluster)
211 DO i=1,ncluster
212 cluster_typ = clusters(i)%TYPE
213 IF(cluster_typ==2.OR.cluster_typ==3) THEN
214 cluster_nel = clusters(i)%NEL
215 ALLOCATE( save_cluster( cluster_nel ) )
216 save_cluster( 1:cluster_nel ) = clusters(i)%ELEM( 1:cluster_nel )
217 DO j=1,cluster_nel
218 clusters(i)%ELEM(j) = itr1( save_cluster( j ) )
219 ENDDO
220 DEALLOCATE( save_cluster )
221 ENDIF
222 ENDDO
223! -----------------------
224C
225C REORDERING FOR SEATBELTS
226C
227 DO i=1,n_seatbelt
228 nn=seatbelt_tab(i)%NSPRING
229 DO j=1,nn
230 seatbelt_tab(i)%SPRING(j) = itr1(seatbelt_tab(i)%SPRING(j))
231 ENDDO
232 ENDDO
233
234C REORDERING FOR ITAGPRLD_SPRING
235 inum(8,1:numelr)=itagprld_spring(1:numelr)
236 DO i=1,numelr
237 itagprld_spring(i) =inum(8,index(i))
238 ENDDO
239C--------------------------------------------------------------
240C determination of super_groups
241C--------------------------------------------------------------
242 nd=1
243 DO i=2,numelr
244 ii=itri(1,index(i))
245 jj=itri(1,index(i-1))
246
247 ii2=itri(2,index(i))
248 jj2=itri(2,index(i-1))
249
250 ii3=itri(3,index(i))
251 jj3=itri(3,index(i-1))
252C
253 ii4=itri(4,index(i))
254 jj4=itri(4,index(i-1))
255
256 ii5=itri(5,index(i))
257 jj5=itri(5,index(i-1))
258
259 mtn = nint(geo(8,ii2))
260 IF (ii /=jj .OR. ii2/=jj2 .OR. ii3/=jj3 .OR.
261 . ii4/=jj4 .OR. ii5/=jj5) THEN
262 nd=nd+1
263 eadd(nd)=i
264 ENDIF
265 ENDDO
266 eadd(nd+1) = numelr+1
267C
268 RETURN
269 END
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
cluster_mod
Definition cluster_mod.F:40
groupdef_mod
Definition groupdef_mod.F:668
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::seatbelt_tab
type(seatbelt_struct), dimension(:), allocatable seatbelt_tab
Definition seatbelt_mod.F:171
my_shiftr
int my_shiftr(int *a, int *n)
Definition precision.c:45
my_shiftl
int my_shiftl(int *a, int *n)
Definition precision.c:36
my_and
int my_and(int *a, int *b)
Definition precision.c:54
rgrhead
subroutine rgrhead(ixr, geo, inum, isel, igeo, itr1, eadd, index, itri, ipartr, nd, igrsurf, igrspring, cep, xep, iresoff, tagprt_sms, clusters, ipm, r_skew, itagprld_spring)
Definition rgrhead.F:37