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
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
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: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