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