OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tgrtails.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!|| tgrtails ../starter/source/elements/truss/tgrtails.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!|| r2r_mod ../starter/share/modules1/r2r_mod.F
32!||====================================================================
33 SUBROUTINE tgrtails(
34 1 IXT ,IPARG ,PM ,GEO ,
35 2 EADD ,ND ,DD_IAD ,IDX ,
36 3 INUM ,INDEX ,CEP ,IPARTT ,
37 4 ITR1 ,IGRSURF,IGRTRUSS,ITRUOFF ,
38 5 TAGPRT_SMS,NOD2EL1D,PRINT_FLAG ,
39 6 ITAGPRLD_TRUSS,PRELOAD_A ,NPRELOAD_A)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE groupdef_mod
44 USE r2r_mod
45 USE bpreload_mod
46C-----------------------------------------------
47C A R G U M E N T S
48C-----------------------------------------------
49C IXT(5,NUMELT) TABLEAU CONECS+PID+MID+NOS TRUSSES E
50C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
51C GEO(NPROPG,NUMGEO) TABLEAU DES CARACS DES PID E
52C EADD(NUMELT) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER E
53C DD_IAD TABLEAU DE LA DD EN SUPER GROUPES S
54C INDEX(NUMELT) TABLEAU DE TRAVAIL E/S
55C INUM(NUMELT) TABLEAU DE TRAVAIL E/S
56C CEP(NUMELT) TABLEAU DE TRAVAIL E/S
57C IPARTT(NUMELT) TABLEAU DE PART E/S
58C ITR1(NUMELT) TABLEAU DE TRAVAIL E/S
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "param_c.inc"
69#include "sms_c.inc"
70#include "units_c.inc"
71#include "vect01_c.inc"
72#include "r2r_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER IDX,ND,ITR1(*),
77 . IXT(5,*), IPARG(NPARG,*),EADD(*),IPARTT(*),
78 . DD_IAD(NSPMD+1,*), INUM(7,*), INDEX(*), CEP(*),
79 . ITRUOFF(*),
80 . TAGPRT_SMS(*),NOD2EL1D(*)
81 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
82 INTEGER, INTENT(IN) :: NPRELOAD_A
83 INTEGER ,INTENT(INOUT), DIMENSION(NUMELT) ::ITAGPRLD_TRUSS
84 my_real
85 . PM(NPROPM,*), GEO(NPROPG,*)
86C-----------------------------------------------
87 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
88 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
89 TYPE(prel1d_) ,DIMENSION(NPRELOAD_A):: PRELOAD_A
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER NGR1, NG, ISSN, MLN, I, NE1, N, NFIX,
94 . mid, pid, nel_prec, ii, p, nel,nb,
95 . mode, work(70000),nn, j,
96 . itag(2*numelt+2*numelp+3*numelr),
97 . ngp(nspmd+1),ipartr2r,iprld
98 DATA nfix/5/
99C=======================================================================
100C
101 ngr1 = ngroup + 1
102C
103C phase 1 : decompostition canonique
104C
105 idx = idx+nd*(nspmd+1)
106 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
107C NSPGROUP = NSPGROUP + ND
108 nft = 0
109C initialisation dd_iad
110 DO n=1,nd
111 DO p=1,nspmd+1
112 dd_iad(p,nspgroup+n) = 0
113 END DO
114 ENDDO
115C
116 DO n=1,nd
117 nel = eadd(n+1)-eadd(n)
118C
119 DO i = 1, nel
120 index(i) = i
121 inum(1,i)=ipartt(nft+i)
122 inum(2,i)=itruoff(nft+i)
123 inum(3,i)=ixt(1,nft+i)
124 inum(4,i)=ixt(2,nft+i)
125 inum(5,i)=ixt(3,nft+i)
126 inum(6,i)=ixt(4,nft+i)
127 inum(7,i)=ixt(5,nft+i)
128 ENDDO
129 mode=0
130 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
131 DO i = 1, nel
132 ipartt(i+nft)=inum(1,index(i))
133 itruoff(nft+i) = inum(2,index(i))
134 ixt(1,i+nft)=inum(3,index(i))
135 ixt(2,i+nft)=inum(4,index(i))
136 ixt(3,i+nft)=inum(5,index(i))
137 ixt(4,i+nft)=inum(6,index(i))
138 ixt(5,i+nft)=inum(7,index(i))
139 itr1(nft+index(i)) = nft+i
140 ENDDO
141
142C REORDERING FOR ITAGPRLD_TRUSS
143 DO i=1,nel
144 inum(2,i) = itagprld_truss(nft+i)
145 ENDDO
146 DO i=1,nel
147 itagprld_truss(nft+i) = inum(2,index(i))
148 ENDDO
149C dd-iad
150 p = cep(nft+index(1))
151 nb = 1
152 DO i = 2, nel
153 IF (cep(nft+index(i))/=p) THEN
154 dd_iad(p+1,nspgroup+n) = nb
155 nb = 1
156 p = cep(nft+index(i))
157 ELSE
158 nb = nb + 1
159 ENDIF
160 ENDDO
161 dd_iad(p+1,nspgroup+n) = nb
162 DO p = 2, nspmd
163 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
164 . + dd_iad(p-1,nspgroup+n)
165 ENDDO
166 DO p = nspmd+1,2,-1
167 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
168 ENDDO
169 dd_iad(1,nspgroup+n) = 1
170C
171C maj CEP
172C
173 DO i = 1, nel
174 index(i) = cep(nft+index(i))
175 ENDDO
176 DO i = 1, nel
177 cep(nft+i) = index(i)
178 ENDDO
179 nft = nft + nel
180 ENDDO
181C
182C RENUMEROTATION POUR SURFACES
183C
184 DO i=1,nsurf
185 nn=igrsurf(i)%NSEG
186 DO j=1,nn
187 IF(igrsurf(i)%ELTYP(j) == 4)
188 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
189 ENDDO
190 ENDDO
191C
192C RENUMEROTATION POUR GROUPES DE SHELL
193C
194 DO i=1,ngrtrus
195 nn=igrtruss(i)%NENTITY
196 DO j=1,nn
197 igrtruss(i)%ENTITY(j) = itr1(igrtruss(i)%ENTITY(j))
198 ENDDO
199 ENDDO
200C
201C renumerotation CONNECTIVITE INVERSE
202C
203 itag = 0
204 DO i=1,2*numelt+2*numelp+3*numelr
205 IF(nod2el1d(i) /= 0 .AND. nod2el1d(i) <= numelt)THEN
206 IF(itag(nod2el1d(i)) == 0) THEN
207 nod2el1d(i)=itr1(nod2el1d(i))
208 itag(nod2el1d(i)) = 1
209 END IF
210 END IF
211 END DO
212C
213C-------------------------------------------------------------------------
214C phase 2 : bornage en groupe de mvsiz
215C ngroup est global, iparg est global mais organise en fonction de dd
216C
217
218 DO 300 n=1,nd
219 nft = 0
220cc LB_L = LBUFEL
221 DO p = 1, nspmd
222 ngp(p)=0
223 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
224 IF (nel>0) THEN
225 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
226 ngp(p)=ngroup
227 ng = (nel-1)/nvsiz + 1
228 DO 220 i=1,ng
229C ngroup global
230 ngroup=ngroup+1
231 ii = eadd(n)+nft
232 mid= ixt(1,ii)
233 mln= int(pm(19,mid))
234 pid= ixt(4,ii)
235 ipartr2r = 0
236 IF (nsubdom>0) ipartr2r = tag_mat(mid)
237 issn=0
238 IF(geo(5,pid)/=0.)issn=1
239 iprld = itagprld_truss(ii)
240C
241 CALL zeroin(1,nparg,iparg(1,ngroup))
242C
243 ne1 = min( nvsiz, nel + nel_prec - nft)
244 iparg(1,ngroup) = mln
245 iparg(2,ngroup) = ne1
246 iparg(3,ngroup) = eadd(n)-1 + nft
247 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
248c other groups using old buffer
249 iparg(5,ngroup) = 4
250 iparg(9,ngroup) = issn
251C reperage groupe/processeur
252 iparg(32,ngroup)= p-1
253C /PRELOAD/AXIAL
254 iparg(72,ngroup)= iprld
255
256 IF ( iprld>0 ) THEN
257 iparg(73,ngroup)= preload_a(iprld)%fun_id
258 iparg(74,ngroup)= preload_a(iprld)%sens_id
259 END IF
260C flag for group of duplicated elements in multidomains
261 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
262C
263 jsms=0
264 IF(isms/=0)THEN
265 IF(idtgrs/=0)THEN
266 IF(tagprt_sms(ipartt(ii))/=0)jsms=1
267 ELSE
268 jsms=1
269 END IF
270 END IF
271 iparg(52,ngroup)=jsms
272C
273 nft = nft + ne1
274 220 CONTINUE
275 ngp(p)=ngroup-ngp(p)
276 ENDIF
277 ENDDO
278C DD_IAD => nb groupes par sous domaine
279 ngp(nspmd+1)=0
280 DO p = 1, nspmd
281 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
282 dd_iad(p,nspgroup+n)=ngp(p)
283 END DO
284 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
285C
286 300 CONTINUE
287C
288 nspgroup = nspgroup + nd
289C
290 IF(print_flag>6) THEN
291 WRITE(iout,1000)
292 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,iparg(5,n),n=ngr1,ngroup)
293 ENDIF
294C
295 1000 FORMAT(/
296 + /6x,'3D - TRUSS ELEMENT GROUPS'/
297 + 6x,'-------------------------'/
298 +' GROUP MATERIAL ELEMENT FIRST ELEMENT'/
299 +' LAW NUMBER ELEMENT TYPE'/)
300 1001 FORMAT(5(1x,i10))
301C
302
303 RETURN
304 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
groupdef_mod
Definition groupdef_mod.F:662
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
bpreload_mod::prel1d_
Definition bpreload_mod.F:57
tgrtails
subroutine tgrtails(ixt, iparg, pm, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartt, itr1, igrsurf, igrtruss, itruoff, tagprt_sms, nod2el1d, print_flag, itagprld_truss, preload_a, npreload_a)
Definition tgrtails.F:40
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47