OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgrhead.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ rgrhead()

subroutine rgrhead ( integer, dimension(nixr,*) ixr,
geo,
integer, dimension(9,*) inum,
integer, dimension(*) isel,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) itr1,
integer, dimension(*) eadd,
integer, dimension(*) index,
integer, dimension(5,*) itri,
integer, dimension(*) ipartr,
integer nd,
type (surf_), dimension(nsurf) igrsurf,
type (group_), dimension(ngrspri) igrspring,
integer, dimension(*) cep,
integer, dimension(*) xep,
integer, dimension(*) iresoff,
integer, dimension(*) tagprt_sms,
type (cluster_), dimension(ncluster) clusters,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) r_skew,
integer, dimension(numelr), intent(inout) itagprld_spring )

Definition at line 31 of file rgrhead.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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