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
43C-----------------------------------------------
44C A R G U M E N T S
45C-----------------------------------------------
46C IXR(6,NUMELR) TABLEAU CONECS+PID+NOS RESSORTS E
47C GEO(NPROPG,NUMGEO)TABLEAU DES CARACS DES PID E
48C INUM(6,NUMELR) TABLEAU DE TRAVAIL E/S
49C ISEL(NSELR) TABLEAU DES RESSORTS CHOISIS POUR TH E/S
50C ITR1(NSELR) TABLEAU DE TRAVAIL E/S
51C EADD(NUMELR) TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER S
52C INDEX(NUMELR) TABLEAU DE TRAVAIL E/S
53C ITRI(4,NUMELR) TABLEAU DE TRAVAIL E/S
54C IPARTR(NUMELR) TABLEAU PART E/S
55C CEP(NUMELR) TABLEAU PROC E/S
56C XEP(NUMELR) TABLEAU PROC E/S
57C-----------------------------------------------
58C I M P L I C I T T Y P E S
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C O M M O N B L O C K S
63C-----------------------------------------------
64#include "vect01_c.inc"
65#include "com04_c.inc"
66#include "param_c.inc"
67#include "sms_c.inc"
68C-----------------------------------------------
69C D U M M Y A R G U M E N T S
70C-----------------------------------------------
71 INTEGER IXR(NIXR,*),ISEL(*),INUM(9,*),IPARTR(*),
72 . EADD(*),ITR1(*),INDEX(*),ITRI(5,*),
73 . ND, CEP(*), XEP(*),IRESOFF(*),R_SKEW(*),
74 . TAGPRT_SMS(*), IGEO(NPROPGI,*),IPM(NPROPMI,*)
75 my_real :: GEO(NPROPG,*)
76 INTEGER ,INTENT(INOUT), DIMENSION(NUMELR) ::ITAGPRLD_SPRING
77C-----------------------------------------------
78 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
79 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
80 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
81C-----------------------------------------------
82C L O C A L V A R I A B L E S
83C-----------------------------------------------
84 INTEGER
85 . i,j,k,l, ng, issn, npn, nn, n, mid, pid ,igtyp,
86 . ii,jj,ii2,jj2,ii3,jj3,ii4,jj4,ii5,jj5,
87 . iflag_gtyp,iprld,
88 . mskmtn,mskisn,mskpid, mode, work(70000)
89 EXTERNAL my_shiftl,my_shiftr,my_and
90 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
91 INTEGER :: CLUSTER_TYP,CLUSTER_NEL
92 INTEGER, DIMENSION(:), ALLOCATABLE :: SAVE_CLUSTER
93
94C
95 DATA mskmtn /o'07770000000'/
96 DATA mskisn /o'00000000700'/
97 DATA mskpid /o'07777777777'/
98C
99C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
100
101C----------------------------------------------------------
102C TRI GLOBAL SUR TOUS LES CRITERES POUR TOUS LES ELEMENTS
103C----------------------------------------------------------
104C
105 DO i=1,numelr
106 eadd(i)=1
107 itri(5,i)=i
108 index(i)=i
109 inum(1,i)=ipartr(i)
110 inum(2,i)=ixr(1,i)
111 inum(3,i)=ixr(2,i)
112 inum(4,i)=ixr(3,i)
113 inum(5,i)=ixr(4,i)
114 inum(6,i)=ixr(5,i)
115 inum(7,i)=ixr(6,i)
116 inum(8,i)=iresoff(i)
117 inum(9,i)=r_skew(i)
118 ENDDO
119
120 DO i=1,numelr
121 xep(i)=cep(i)
122 ENDDO
123
124 DO i = 1, numelr
125 ii = i
126 pid = ixr(1,ii)
127 mid = ixr(5,ii)
128 mtn = nint(geo(8,pid))
129 issn = 0
130 IF(geo(5,pid)/=zero) issn=1
131 igtyp = igeo(11,pid)
132 iflag_gtyp = 0
133 IF(igtyp == 23)THEN
134 iflag_gtyp = 1
135 mtn = ipm(2,mid)
136 ENDIF
137 iprld = itagprld_spring(ii)
138 IF (iprld>0) iflag_gtyp = 1+iprld
139C
140 jsms = 0
141 IF(isms/=0)THEN
142 IF(idtgrs/=0)THEN
143 IF(tagprt_sms(ipartr(ii))/=0)jsms=1
144 ELSE
145 jsms=1
146 END IF
147 END IF
148C JSMS=MY_SHIFTL(JSMS,0)
149C NEXT=MY_SHIFTL(NEXT,1)
150 issn=my_shiftl(issn,6)
151 mtn=my_shiftl(mtn,21)
152C
153 itri(1,i)=jsms + issn + mtn
154
155 itri(2,i)=pid
156C
157 itri(3,i)=iresoff(i)
158C
159 itri(4,i)=iflag_gtyp
160C
161 itri(5,i)=mid
162 ENDDO
163C
164 mode=0
165 CALL my_orders( mode, work, itri, index, numelr , 5)
166C
167 DO i=1,numelr
168 ipartr(i) =inum(1,index(i))
169 iresoff(i)=inum(8,index(i))
170 r_skew(i)=inum(9,index(i))
171 ENDDO
172
173 DO i=1,numelr
174 cep(i)=xep(index(i))
175 ENDDO
176
177 DO k=1,6
178 DO i=1,numelr
179 ixr(k,i)=inum(k+1,index(i))
180 ENDDO
181 ENDDO
182C
183C INVERSION DE INDEX (DANS ITR1)
184C
185 DO i=1,numelr
186 itr1(index(i))=i
187 ENDDO
188C
189C RENUMEROTATION POUR SURFACES
190C
191 DO i=1,nsurf
192 nn=igrsurf(i)%NSEG
193 DO j=1,nn
194 IF(igrsurf(i)%ELTYP(j) == 6)
195 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
196 ENDDO
197 ENDDO
198C
199C RENUMEROTATION POUR GROUPES DE RESSORTS
200C
201 DO i=1,ngrspri
202 nn=igrspring(i)%NENTITY
203 DO j=1,nn
204 igrspring(i)%ENTITY(j) = itr1(igrspring(i)%ENTITY(j))
205 ENDDO
206 ENDDO
207
208! -----------------------
209! reordering for cluster typ=2 or 3 (spring cluster)
210 DO i=1,ncluster
211 cluster_typ = clusters(i)%TYPE
212 IF(cluster_typ==2.OR.cluster_typ==3) THEN
213 cluster_nel = clusters(i)%NEL
214 ALLOCATE( save_cluster( cluster_nel ) )
215 save_cluster( 1:cluster_nel ) = clusters(i)%ELEM( 1:cluster_nel )
216 DO j=1,cluster_nel
217 clusters(i)%ELEM(j) = itr1( save_cluster( j ) )
218 ENDDO
219 DEALLOCATE( save_cluster )
220 ENDIF
221 ENDDO
222! -----------------------
223C
224C REORDERING FOR SEATBELTS
225C
226 DO i=1,n_seatbelt
227 nn=seatbelt_tab(i)%NSPRING
228 DO j=1,nn
229 seatbelt_tab(i)%SPRING(j) = itr1(seatbelt_tab(i)%SPRING(j))
230 ENDDO
231 ENDDO
232
233C REORDERING FOR ITAGPRLD_SPRING
234 inum(8,1:numelr)=itagprld_spring(1:numelr)
235 DO i=1,numelr
236 itagprld_spring(i) =inum(8,index(i))
237 ENDDO
238C--------------------------------------------------------------
239C DETERMINATION DES SUPER_GROUPES
240C--------------------------------------------------------------
241 nd=1
242 DO i=2,numelr
243 ii=itri(1,index(i))
244 jj=itri(1,index(i-1))
245
246 ii2=itri(2,index(i))
247 jj2=itri(2,index(i-1))
248
249 ii3=itri(3,index(i))
250 jj3=itri(3,index(i-1))
251C
252 ii4=itri(4,index(i))
253 jj4=itri(4,index(i-1))
254
255 ii5=itri(5,index(i))
256 jj5=itri(5,index(i-1))
257
258 mtn = nint(geo(8,ii2))
259 IF (ii /=jj .OR. ii2/=jj2 .OR. ii3/=jj3 .OR.
260 . ii4/=jj4 .OR. ii5/=jj5) THEN
261 nd=nd+1
262 eadd(nd)=i
263 ENDIF
264 ENDDO
265 eadd(nd+1) = numelr+1
266C
267 RETURN
268 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:662
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
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
starter
program starter
Definition starter.F:39