OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgrtails.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!|| rgrtails ../starter/source/elements/spring/rgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| zeroin ../starter/source/system/zeroin.F
29!||--- uses -----------------------------------------------------
30!|| bpreload_mod ../starter/share/modules1/bpreload_mod.F
31!|| cluster_mod ../starter/share/modules1/cluster_mod.F
32!|| r2r_mod ../starter/share/modules1/r2r_mod.F
33!||====================================================================
34 SUBROUTINE rgrtails(
35 1 IXR ,IPARG ,GEO ,EADD ,IGEO ,
36 2 ND ,DD_IAD ,IDX ,INUM ,
37 3 INDEX ,CEP ,IPARTR ,ITR1 ,
38 4 IGRSURF ,IGRSPRING,IRESOFF ,TAGPRT_SMS,NOD2EL1D,
39 5 IPM ,CLUSTERS ,R_SKEW,PRINT_FLAG,
40 6 ITAGPRLD_SPRING,PRELOAD_A,NPRELOAD_A)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE groupdef_mod
45 USE r2r_mod
46 USE cluster_mod
47 USE seatbelt_mod
48 USE bpreload_mod
49 use element_mod , only : nixr
50C-----------------------------------------------
51C A R G U M E N T S
52C-----------------------------------------------
53C IXR(6,NUMELR) CONNECTIVITY+PID+SPRING NUMBERS TABLE E
54C IPARG(NPARG,NGROUP)TABLE OF GROUP CHARACTERISTICS E/S
55C geo(npropG,numgeo)table of characteristics of pid
56C EADD(NUMELR) TABLE OF ADDRESSES IN IDAM CHGT DAMIER E
57C dd_iad table of dd in super groups
58C INDEX(NUMELR) WORK TABLE E/S
59C INUM (6*NUMELR) WORK TABLE E/S
60C CEP(NUMELR) WORK TABLE E/S
61C ITR1(NUMELR) WORK TABLE E/S
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "sms_c.inc"
73#include "units_c.inc"
74#include "vect01_c.inc"
75#include "r2r_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER IDX,ND,ITR1(*), IGEO(NPROPGI,*),
80 . IXR(NIXR,*), IPARG(NPARG,*),EADD(*),IPARTR(*),
81 . DD_IAD(NSPMD+1,*),INUM(9,*),INDEX(*),CEP(*),
82 . IRESOFF(*),TAGPRT_SMS(*),NOD2EL1D(*),IPM(NPROPMI,*),R_SKEW(*)
83 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
84 INTEGER,INTENT(IN) :: NPRELOAD_A
85 INTEGER ,INTENT(INOUT), DIMENSION(NUMELR) :: ITAGPRLD_SPRING
86 my_real
87 . GEO(NPROPG,*)
88C-----------------------------------------------
89 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
90 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
91 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
92 TYPE(prel1d_) ,DIMENSION(NPRELOAD_A) :: PRELOAD_A
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96C INTEGER NMTV(4), NGR1, NG, ISSN, MTNN, I, NE1, N, NFIX,
97 INTEGER NGR1, NG, ISSN, MTNN, I, NE1, N,
98 . pid, nel_prec, ii, p, nel, igtyp,nb,
99 . mode, work(70000),nn,j,mid,
100 . itag(2*numelt+2*numelp+3*numelr),
101 . ngp(nspmd+1),ipartr2r,iprld
102 INTEGER :: CLUSTER_TYP,CLUSTER_NEL
103 INTEGER, DIMENSION(:), ALLOCATABLE :: SAVE_CLUSTER
104
105C=======================================================================
106
107 NGR1 = ngroup + 1
108C
109C Phase 1: Canonical decomposition
110C
111 idx=idx+nd*(nspmd+1)
112 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
113C NSPGROUP = NSPGROUP + ND
114 nft = 0
115C initialisation dd_iad
116 DO n=1,nd
117 DO p=1,nspmd+1
118 dd_iad(p,nspgroup+n) = 0
119 END DO
120 ENDDO
121C
122 DO n=1,nd
123 nel = eadd(n+1)-eadd(n)
124C
125 DO i = 1, nel
126 index(i) = i
127 inum(1,i)=ipartr(nft+i)
128 inum(2,i)=ixr(1,nft+i)
129 inum(3,i)=ixr(2,nft+i)
130 inum(4,i)=ixr(3,nft+i)
131 inum(5,i)=ixr(4,nft+i)
132 inum(6,i)=ixr(5,nft+i)
133 inum(7,i)=ixr(6,nft+i)
134 inum(8,i)=iresoff(nft+i)
135 inum(9,i)=r_skew(nft+i)
136 ENDDO
137
138 mode=0
139 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
140 DO i = 1, nel
141 ipartr(i+nft)=inum(1,index(i))
142 ixr(1,i+nft)=inum(2,index(i))
143 ixr(2,i+nft)=inum(3,index(i))
144 ixr(3,i+nft)=inum(4,index(i))
145 ixr(4,i+nft)=inum(5,index(i))
146 ixr(5,i+nft)=inum(6,index(i))
147 ixr(6,i+nft)=inum(7,index(i))
148 iresoff(nft+i)=inum(8,index(i))
149 r_skew(nft+i)=inum(9,index(i))
150 itr1(nft+index(i)) = nft+i
151 ENDDO
152C REORDERING FOR ITAGPRLD_SPRING
153 DO i=1,nel
154 inum(8,i)=itagprld_spring(nft+i)
155 ENDDO
156 DO i=1,nel
157 itagprld_spring(nft+i) =inum(8,index(i))
158 ENDDO
159C dd-iad
160 p = cep(nft+index(1))
161 nb = 1
162 DO i = 2, nel
163 IF (cep(nft+index(i))/=p) THEN
164 dd_iad(p+1,nspgroup+n) = nb
165 nb = 1
166 p = cep(nft+index(i))
167 ELSE
168 nb = nb + 1
169 ENDIF
170 ENDDO
171 dd_iad(p+1,nspgroup+n) = nb
172 DO p = 2, nspmd
173 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
174 . + dd_iad(p-1,nspgroup+n)
175 ENDDO
176 DO p = nspmd+1,2,-1
177 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
178 ENDDO
179 dd_iad(1,nspgroup+n) = 1
180C
181C maj CEP
182C
183 DO i = 1, nel
184 index(i) = cep(nft+index(i))
185 ENDDO
186 DO i = 1, nel
187 cep(nft+i) = index(i)
188 ENDDO
189 nft = nft + nel
190 ENDDO
191C
192C renumbering for surfaces
193C
194 DO i=1,nsurf
195 nn=igrsurf(i)%NSEG
196 DO j=1,nn
197 IF(igrsurf(i)%ELTYP(j) == 6)
198 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
199 ENDDO
200 ENDDO
201C
202C renumbering for shell groups
203C
204 DO i=1,ngrspri
205 nn=igrspring(i)%NENTITY
206 DO j=1,nn
207 igrspring(i)%ENTITY(j) = itr1(igrspring(i)%ENTITY(j))
208 ENDDO
209 ENDDO
210C
211C renumerotation CONNECTIVITE INVERSE
212C
213 itag = 0
214 DO i=1,2*numelt+2*numelp+3*numelr
215 IF(nod2el1d(i) /= 0 .AND. nod2el1d(i) > numelt+numelp)THEN
216 IF(itag(nod2el1d(i)) == 0) THEN
217 nod2el1d(i)=itr1(nod2el1d(i)-numelt-numelp)
218 nod2el1d(i)=nod2el1d(i)+numelt+numelp
219 itag(nod2el1d(i)) = 1
220 END IF
221 END IF
222 END DO
223
224! -----------------------
225! reordering for cluster typ=2 or 3 (spring cluster)
226 DO i=1,ncluster
227 cluster_typ = clusters(i)%TYPE
228 IF(cluster_typ==2.OR.cluster_typ==3) THEN
229 cluster_nel = clusters(i)%NEL
230 ALLOCATE( save_cluster( cluster_nel ) )
231 save_cluster( 1:cluster_nel ) = clusters(i)%ELEM( 1:cluster_nel )
232 DO j=1,cluster_nel
233 clusters(i)%ELEM(j) = itr1( save_cluster( j ) )
234 ENDDO
235 DEALLOCATE( save_cluster )
236 ENDIF
237 ENDDO
238! -----------------------
239C
240C REORDERING FOR SEATBELTS
241C
242 DO i=1,n_seatbelt
243 nn=seatbelt_tab(i)%NSPRING
244 DO j=1,nn
245 seatbelt_tab(i)%SPRING(j) = itr1(seatbelt_tab(i)%SPRING(j))
246 ENDDO
247 ENDDO
248C
249C-------------------------------------------------------------------------
250C Phase 2: MVSIZ Group Bounds
251C ngroup is global, iparg is global but organized according to dd
252C
253 DO 300 n=1,nd
254 nft = 0
255cc LB_L = LBUFEL
256 DO p = 1, nspmd
257 ngp(p)=0
258 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
259 IF (nel>0) THEN
260 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
261 ngp(p)=ngroup
262 ng = (nel-1)/nvsiz + 1
263 DO 220 i=1,ng
264C ngroup global
265 ngroup=ngroup+1
266 ii = eadd(n)+nft
267 pid= ixr(1,ii)
268C Multidomains - spring not duplicated
269 IF (nsubdom>0) ipartr2r = 1
270 mtnn = nint(geo(8,pid))
271 igtyp= igeo(11,pid)
272 issn=0
273 IF(geo(5,pid)/=0.)issn=1
274 IF(igtyp == 23) THEN
275 mid = ixr(5,ii)
276 mtnn = ipm(2,mid)
277 ENDIF
278 iprld = itagprld_spring(ii)
279C
280 CALL zeroin(1,nparg,iparg(1,ngroup))
281C
282 ne1 = min( nvsiz, nel + nel_prec - nft)
283 iparg(1,ngroup) = mtnn
284 iparg(2,ngroup) = ne1
285 iparg(3,ngroup) = eadd(n)-1 + nft
286 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
287c other groups using old buffer
288 iparg(5,ngroup) = 6
289 iparg(9,ngroup) = issn
290C Group/Processor Splition
291 iparg(32,ngroup)= p-1
292 iparg(38,ngroup)= igtyp
293C flag for group of duplicated elements in multidomains
294 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
295C
296 jsms=0
297 IF(isms/=0)THEN
298 IF(idtgrs/=0)THEN
299 IF(tagprt_sms(ipartr(ii))/=0)jsms=1
300 ELSE
301 jsms=1
302 END IF
303 END IF
304 iparg(52,ngroup)=jsms
305C /PRELOAD/AXIAL
306 iparg(72,ngroup)= iprld
307
308 IF ( iprld>0 ) THEN
309 iparg(73,ngroup)= preload_a(iprld)%fun_id
310 iparg(74,ngroup)= preload_a(iprld)%sens_id
311 END IF
312C
313 nft = nft + ne1
314 220 CONTINUE
315 ngp(p)=ngroup-ngp(p)
316 ENDIF
317 ENDDO
318C Dd_iad => nb groups by sub -domain
319 ngp(nspmd+1)=0
320 DO p = 1, nspmd
321 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
322 dd_iad(p,nspgroup+n)=ngp(p)
323 END DO
324 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
325C
326 300 CONTINUE
327C
328 nspgroup = nspgroup + nd
329C
330 IF(print_flag>6) THEN
331 WRITE(iout,1000)
332 WRITE(iout,1001)(n,igtyp,iparg(2,n),iparg(3,n)+1,iparg(5,n),n=ngr1,ngroup)
333 ENDIF
334C
335 1000 FORMAT(/
336 + /6x,'3D - SPRING ELEMENT GROUPS'/
337 + 6x,'-------------------------'/
338 +' GROUP SPRING ELEMENT FIRST ELEMENT'/
339 +' TYPE NUMBER ELEMENT TYPE'/)
340 1001 FORMAT(5(1x,i10))
341C
342 RETURN
343 END
min
#define min(a, b)
Definition macros.h:20
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
bpreload_mod
Definition bpreload_mod.F:40
cluster_mod
Definition cluster_mod.F:40
groupdef_mod
Definition groupdef_mod.F:668
r2r_mod
Definition r2r_mod.F:125
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::seatbelt_tab
type(seatbelt_struct), dimension(:), allocatable seatbelt_tab
Definition seatbelt_mod.F:171
rgrtails
subroutine rgrtails(ixr, iparg, geo, eadd, igeo, nd, dd_iad, idx, inum, index, cep, ipartr, itr1, igrsurf, igrspring, iresoff, tagprt_sms, nod2el1d, ipm, clusters, r_skew, print_flag, itagprld_spring, preload_a, npreload_a)
Definition rgrtails.F:41
bpreload_mod::prel1d_
Definition bpreload_mod.F:57
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47