OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pgrtails.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!|| pgrtails ../starter/source/elements/beam/pgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| zeroin ../starter/source/system/zeroin.F
31!||--- uses -----------------------------------------------------
32!|| bpreload_mod ../starter/share/modules1/bpreload_mod.F
33!|| message_mod ../starter/share/message_module/message_mod.f
34!|| r2r_mod ../starter/share/modules1/r2r_mod.F
35!|| reorder_mod ../starter/share/modules1/reorder_mod.F
36!||====================================================================
37 SUBROUTINE pgrtails(MAT_PARAM,
38 1 IXP ,IPARG ,PM ,GEO ,
39 2 EADD ,ND ,DD_IAD ,IDX ,
40 3 INUM ,INDEX ,CEP ,IPARTP ,
41 4 ITR1 ,IGRSURF,IGRBEAM ,IGEO ,
42 5 IPM ,IPOUOFF,TAGPRT_SMS ,
43 6 NOD2EL1D,PRINT_FLAG,ITAGPRLD_BEAM,
44 7 PRELOAD_A,NPRELOAD_A,IBEAM_VECTOR,RBEAM_VECTOR,XNUM)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE groupdef_mod
49 USE r2r_mod
50 USE message_mod
51 USE reorder_mod
52 USE matparam_def_mod
53 USE bpreload_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55C-----------------------------------------------
56C A R G U M E N T S
57C-----------------------------------------------
58C IXP(6,NUMELP) TABLEAU CONECS+PID+MID+NOS POUTRES E
59C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
60C GEO(NPROPG,NUMGEO) TABLEAU DES CARACS DES PID E
61C EADD(NUMELP) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER E
62C DD_IAD TABLEAU DE LA DD EN SUPER GROUPES S
63C INUM(9,NUMELP) TABLEAU DE TRAVAIL E/S
64C INDEX(NUMELP) TABLEAU DE TRAVAIL E/S
65C CEP(NUMELP) TABLEAU DE TRAVAIL E/S
66C IPARTP(NUMELP) TABLEAU DE PART E/S
67C ITR1(NSELP) TABLEAU DE TRAVAIL E/S
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "param_c.inc"
78#include "sms_c.inc"
79#include "units_c.inc"
80#include "vect01_c.inc"
81#include "scr17_c.inc"
82#include "r2r_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER IDX,LB_MAX,ND
87 INTEGER ITR1(*),IXP(6,*),IPARG(NPARG,*),EADD(*),IPARTP(*),
88 . DD_IAD(NSPMD+1,*),CEP(*),INUM(9,*),INDEX(*),
89 . IPM(NPROPMI,*),IPOUOFF(*),
90 . TAGPRT_SMS(*),NOD2EL1D(*),IGEO(NPROPGI,*)
91 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
92 INTEGER, INTENT(IN) :: NPRELOAD_A
93 INTEGER ,INTENT(INOUT), DIMENSION(NUMELP) :: ITAGPRLD_BEAM
94 INTEGER ,INTENT(INOUT) :: IBEAM_VECTOR(NUMELP)
95 my_real
96 . PM(NPROPM,*), GEO(NPROPG,*)
97 my_real ,INTENT(INOUT) :: RBEAM_VECTOR(3,NUMELP)
98 my_real ,INTENT(INOUT) :: xnum(3,numelp)
99 TYPE(matparam_struct_) ,DIMENSION(NUMMAT), INTENT(IN) :: MAT_PARAM
100C-----------------------------------------------
101 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
102 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
103 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A) :: PRELOAD_A
104C-----------------------------------------------
105C L o c a l V a r i a b l e s
106C-----------------------------------------------
107 INTEGER NGR1, NG, ISSN, MLN, I, NE1, N, NFIX,
108 . mid, pid, nel_prec, ii, p, nel,nb,nip,igtyp,
109 . mode,nn, j,
110 . itag(2*numelt+2*numelp+3*numelr),
111 . ngp(nspmd+1),ipartr2r,nuvar,ie,id1,iprld
112 INTEGER ID
113 CHARACTER(LEN=NCHARTITLE)::TITR,TITR1
114 INTEGER WORK(70000)
115 DATA NFIX/13/
116C=======================================================================
117 NGR1 = ngroup + 1
118C
119C phase 1 : decompostition canonique
120
121 idx=idx+nd*(nspmd+1)
122 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
123C NSPGROUP = NSPGROUP + ND
124 nft = 0
125C initialisation dd_iad
126 DO n=1,nd
127 DO p=1,nspmd+1
128 dd_iad(p,nspgroup+n) = 0
129 END DO
130 ENDDO
131
132 DO n=1,nd
133 nel = eadd(n+1)-eadd(n)
134 DO i = 1, nel
135 index(i) = i
136 inum(1,i)=ipartp(nft+i)
137 inum(2,i)=ixp(1,nft+i)
138 inum(3,i)=ixp(2,nft+i)
139 inum(4,i)=ixp(3,nft+i)
140 inum(5,i)=ixp(4,nft+i)
141 inum(6,i)=ixp(5,nft+i)
142 inum(7,i)=ixp(6,nft+i)
143 inum(8,i)=ipouoff(nft+i)
144 inum(9,i)=ibeam_vector(nft+i)
145 xnum(1:3,i)=rbeam_vector(1:3,nft+i)
146 ENDDO
147
148 mode=0
149 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
150 DO i = 1, nel
151 ipartp(i+nft)=inum(1,index(i))
152 ixp(1,i+nft)=inum(2,index(i))
153 ixp(2,i+nft)=inum(3,index(i))
154 ixp(3,i+nft)=inum(4,index(i))
155 ixp(4,i+nft)=inum(5,index(i))
156 ixp(5,i+nft)=inum(6,index(i))
157 ixp(6,i+nft)=inum(7,index(i))
158 ipouoff(nft+i)=inum(8,index(i))
159 ibeam_vector(nft+i)=inum(9,index(i))
160 rbeam_vector(1:3,nft+i)=xnum(1:3,index(i))
161 itr1(nft+index(i)) = nft+i
162 ENDDO
163C REORDERING FOR ITAGPRLD_BEAM
164 DO i=1,nel
165 inum(8,i) = itagprld_beam(nft+i)
166 ENDDO
167 DO i=1,nel
168 itagprld_beam(nft+i) = inum(8,index(i))
169 ENDDO
170C dd-iad
171 p = cep(nft+index(1))
172 nb = 1
173 DO i = 2, nel
174 IF (cep(nft+index(i))/=p) THEN
175 dd_iad(p+1,nspgroup+n) = nb
176 nb = 1
177 p = cep(nft+index(i))
178 ELSE
179 nb = nb + 1
180 ENDIF
181 ENDDO
182 dd_iad(p+1,nspgroup+n) = nb
183 DO p = 2, nspmd
184 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
185 . + dd_iad(p-1,nspgroup+n)
186 ENDDO
187 DO p = nspmd+1,2,-1
188 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
189 ENDDO
190 dd_iad(1,nspgroup+n) = 1
191C
192C maj CEP
193C
194 DO i = 1, nel
195 index(i) = cep(nft+index(i))
196 ENDDO
197 DO i = 1, nel
198 cep(nft+i) = index(i)
199 ENDDO
200 nft = nft + nel
201 ENDDO
202C
203C RENUMEROTATION POUR SURFACES
204C
205 DO i=1,nsurf
206 nn=igrsurf(i)%NSEG
207 DO j=1,nn
208 IF(igrsurf(i)%ELTYP(j) == 5)
209 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
210 ENDDO
211 ENDDO
212C
213C RENUMEROTATION POUR GROUPES DE SHELL
214C
215 DO i=1,ngrbeam
216 nn=igrbeam(i)%NENTITY
217 DO j=1,nn
218 igrbeam(i)%ENTITY(j) = itr1(igrbeam(i)%ENTITY(j))
219 ENDDO
220 ENDDO
221C
222C renumerotation CONNECTIVITE INVERSE
223C
224 itag = 0
225 DO i=1,2*numelt+2*numelp+3*numelr
226 IF(nod2el1d(i) /= 0 .AND. numelt < nod2el1d(i)
227 . .AND. nod2el1d(i) <= numelt+numelp)THEN
228 IF(itag(nod2el1d(i)) == 0) THEN
229 nod2el1d(i)=itr1(nod2el1d(i)-numelt)
230 nod2el1d(i)=nod2el1d(i)+numelt
231 itag(nod2el1d(i)) = 1
232 END IF
233 END IF
234 END DO
235C
236C-------------------------------------------------------------------------
237C phase 2 : bornage en groupe de mvsiz
238C ngroup est global, iparg est global mais organise en fonction de dd
239C
240 DO 300 n=1,nd
241 nft = 0
242cc LB_L = LBUFEL
243 DO p = 1, nspmd
244 ngp(p)=0
245 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
246 IF (nel>0) THEN
247 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
248 ngp(p)=ngroup
249 ng = (nel-1)/nvsiz + 1
250 DO i=1,ng
251 !---ngroup global
252 ngroup=ngroup+1
253 ii = eadd(n)+nft
254 mid= ixp(1,ii)
255 mln= int(pm(19,mid))
256 pid= ixp(5,ii)
257 ipartr2r = 0
258 IF (nsubdom>0) ipartr2r = tag_mat(mid)
259 issn=0
260 IF(geo(5,pid)/=zero)issn=1
261 nip = 1
262 igtyp = igeo(11,pid)
263 IF (igtyp == 18) nip = igeo(3,pid)
264 CALL zeroin(1,nparg,iparg(1,ngroup))
265 iprld = itagprld_beam(ii)
266
267 ne1 = min( nvsiz, nel + nel_prec - nft)
268C---
269 jthe = nint(pm(71,mid))
270
271 !!
272 IF(igtyp == 3 .AND. mln == 34 ) THEN
273 id=ipm(1,mid)
274 id1= igeo(1,pid)
275 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,pid),ltitr)
276 CALL fretitl2(titr,ipm(npropmi-ltitr+1,mid),ltitr)
277
278 CALL ancmsg(msgid=2050,
279 . msgtype=msgerror,
280 . anmode=aninfo,
281 . i1=id1,
282 . c1=titr1,
283 . i2=id,
284 . c2=titr)
285 ENDIF
286 !!
287 nuvar = 0
288 DO j = 1,ne1
289 ie=j+eadd(n)+nft-1
290 nuvar = max(nuvar,ipm(8,ixp(1,ie)))
291 END DO
292 iparg(46,ngroup) = nuvar
293C---
294 iparg(1,ngroup) = mln
295 iparg(2,ngroup) = ne1
296 iparg(3,ngroup) = eadd(n)-1 + nft
297 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
298c other groups using old buffer
299 iparg(5,ngroup) = 5
300 iparg(6,ngroup) = nip
301 iparg(9,ngroup) = nint(geo(3,pid))
302 iparg(13,ngroup) = jthe !beam : 0 or 1 only
303 iparg(38,ngroup) = igtyp
304 !---reperage groupe/processeur
305 iparg(32,ngroup)= p-1
306C flag for group of duplicated elements in multidomains
307 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
308C thermal material expansion
309 iparg(49,ngroup) = 0
310 IF(ipm(218,mid) > 0 .AND. mln /= 0 .AND. mln /=13) THEN
311 iparg(49,ngroup) = 1
312 ENDIF
313 ! check failure models
314 IF (mat_param(mid)%NFAIL > 0) THEN
315 iparg(43,ngroup) = 1 ! IFAIL flag
316 ENDIF
317 ! Property internal ID
318 iparg(62,ngroup) = pid
319C /PRELOAD/AXIAL
320 iparg(72,ngroup)= iprld
321
322 IF ( iprld>0 ) THEN
323 iparg(73,ngroup)= preload_a(iprld)%fun_id
324 iparg(74,ngroup)= preload_a(iprld)%sens_id
325 END IF
326
327 jsms=0
328 IF(isms/=0)THEN
329 IF(idtgrs/=0)THEN
330 IF(tagprt_sms(ipartp(ii))/=0)jsms=1
331 ELSE
332 jsms=1
333 END IF
334 END IF
335 iparg(52,ngroup)=jsms
336c
337 nft = nft + ne1
338 END DO !I=1,NG
339 ngp(p)=ngroup-ngp(p)
340 ENDIF
341 ENDDO
342 !--- DD_IAD => nb groupes par sous domaine
343 ngp(nspmd+1)=0
344 DO p = 1, nspmd
345 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
346 dd_iad(p,nspgroup+n)=ngp(p)
347 END DO
348 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
349
350 300 CONTINUE
351
352 nspgroup = nspgroup + nd
353
354 IF(print_flag>6) THEN
355 WRITE(iout,1000)
356 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
357 + iparg(5,n),
358 + n=ngr1,ngroup)
359 ENDIF
360 1000 FORMAT(/
361 + /6x,'3D - BEAM ELEMENT GROUPS'/
362 + 6x,'-------------------------'/
363 +' GROUP MATERIAL ELEMENT FIRST ELEMENT'/
364 +' LAW NUMBER ELEMENT TYPE'/)
365 1001 FORMAT(5(1x,i10))
366
367
368 RETURN
369 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
reorder_mod
Definition reorder_mod.F:45
pgrtails
subroutine pgrtails(mat_param, ixp, iparg, pm, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartp, itr1, igrsurf, igrbeam, igeo, ipm, ipouoff, tagprt_sms, nod2el1d, print_flag, itagprld_beam, preload_a, npreload_a, ibeam_vector, rbeam_vector, xnum)
Definition pgrtails.F:45
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
starter
program starter
Definition starter.F:39
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47