OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xgrtails.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!|| xgrtails ../starter/source/elements/xelem/xgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!|| zeroin ../starter/source/system/zeroin.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!|| r2r_mod ../starter/share/modules1/r2r_mod.F
33!||====================================================================
34 SUBROUTINE xgrtails(
35 1 KXX ,IPARG ,GEO ,EADD,
36 2 ND ,DD_IAD ,IDX ,LB_MAX, INUM,
37 3 INDEX ,CEP ,IPARTX ,ITR1, IGRSURF,
38 4 IXX , IGEO)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE r2r_mod
44 USE groupdef_mod
45C-----------------------------------------------
46C A R G U M E N T S
47C-----------------------------------------------
48C KXX(5,NUMELX) TABLEAU CONECS+PID+NOS RESSORTS E
49C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
50C GEO(NPROPG,NUMGEO) TABLEAU DES CARACS DES PID E
51C EADD(NUMELX) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER E
52C DD_IAD TABLEAU DE LA DD EN SUPER GROUPES S
53C INDEX(NUMELX) TABLEAU DE TRAVAIL E/S
54C INUM (6*NUMELX) TABLEAU DE TRAVAIL E/S
55C CEP(NUMELX) TABLEAU DE TRAVAIL E/S
56C ITR1(NUMELX) TABLEAU DE TRAVAIL E/S
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "units_c.inc"
67#include "param_c.inc"
68#include "vect01_c.inc"
69#include "r2r_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER KXX(5,*),IPARG(NPARG,*),EADD(*),
74 . ND, DD_IAD(NSPMD+1,*),IDX,IGEO(NPROPGI,*),
75 . LB_MAX, INUM(6,*), INDEX(*),CEP(*),
76 . IPARTX(*), ITR1(*)
77 my_real
78 . geo(npropg,*)
79 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER NGR1, NG, ISSN, MTNN, I, NE1, N, NFIX,
84 . PID, NEL_PREC, LB_L, P, NEL, IGTYP,NB,
85 . MODE, WORK(70000),NN,NGROU, J,MID,IETYP,
86 . MT,IXX(*),NUVAR,NUVARN,NXVIE,NXVIN,INND,II,inno,
87 . ngp(nspmd+1),ipartr2r
88C
89 INTEGER, DIMENSION(:), ALLOCATABLE :: MINDEXX2
90 DATA NXVIE/3/, NXVIN/0/
91C----------------------------------------------------------
92 NGR1 = ngroup + 1
93C
94C phase 1 : decompostition canonique
95C
96 idx=idx+nd*(nspmd+1)
97 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
98 nft = 0
99C initialisation dd_iad
100 DO n=1,nd
101 DO p=1,nspmd+1
102 dd_iad(p,nspgroup+n) = 0
103 END DO
104 ENDDO
105
106 DO n=1,nd
107 nel = eadd(n+1)-eadd(n)
108C
109 DO i = 1, nel
110 index(i) = i
111 inum(1,i)=ipartx(nft+i)
112 inum(2,i)=kxx(1,nft+i)
113 inum(3,i)=kxx(2,nft+i)
114 inum(4,i)=kxx(3,nft+i)
115 inum(5,i)=kxx(4,nft+i)
116 inum(6,i)=kxx(5,nft+i)
117 ENDDO
118
119 mode=0
120 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
121 DO i = 1, nel
122 ipartx(i+nft)=inum(1,index(i))
123 kxx(1,i+nft)=inum(2,index(i))
124 kxx(2,i+nft)=inum(3,index(i))
125 kxx(3,i+nft)=inum(4,index(i))
126 kxx(4,i+nft)=inum(5,index(i))
127 kxx(5,i+nft)=inum(6,index(i))
128 itr1(nft+index(i)) = nft+i
129 ENDDO
130C dd-iad
131 p = cep(nft+index(1))
132 nb = 1
133 DO i = 2, nel
134 IF (cep(nft+index(i))/=p) THEN
135 dd_iad(p+1,nspgroup+n) = nb
136 nb = 1
137 p = cep(nft+index(i))
138 ELSE
139 nb = nb + 1
140 ENDIF
141 ENDDO
142 dd_iad(p+1,nspgroup+n) = nb
143 DO p = 2, nspmd
144 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
145 . + dd_iad(p-1,nspgroup+n)
146 ENDDO
147 DO p = nspmd+1,2,-1
148 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
149 ENDDO
150 dd_iad(1,nspgroup+n) = 1
151C
152C maj CEP
153C
154 DO i = 1, nel
155 index(i) = cep(nft+index(i))
156 ENDDO
157 DO i = 1, nel
158 cep(nft+i) = index(i)
159 ENDDO
160 nft = nft + nel
161 ENDDO
162C
163C RENUMEROTATION POUR SURFACE voir pour 100==ITYP
164C
165 DO i=1,nsurf
166 nn=igrsurf(i)%NSEG
167 DO j=1,nn
168 IF(igrsurf(i)%ELTYP(j) == 100)
169 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
170 ENDDO
171 ENDDO
172
173C phase 2 : bornage en groupe de mvsiz
174C ngroup est global, iparg est global mais organise en fonction de dd
175C
176 DO 300 n=1,nd
177 nft = 0
178cc LB_L = LBUFEL
179 DO p = 1, nspmd
180 ngp(p)=0
181 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
182 IF (nel>0) THEN
183 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
184 ngp(p)=ngroup
185 ng = (nel-1)/nvsiz + 1
186 DO 220 i=1,ng
187C xgroup global
188 ngroup=ngroup+1
189 ii = eadd(n)+nft
190C Multidomains - xelem not duplicated
191 IF (nsubdom>0) ipartr2r = 1
192 pid = kxx(2,ii)
193 innd = kxx(3,ii)
194 mtnn=geo(8,pid)
195 igtyp=nint(geo(12,pid))
196 IF(igtyp<28.OR.igtyp>31) THEN
197 CALL ancmsg(msgid=413,
198 . msgtype=msgerror,
199 . anmode=aninfo_blind_1,
200 . i1=kxx(5,i),
201 . c1='PROPERTY',
202 . i2=igeo(1,pid),
203 . c2='PROPERTY',
204 . i3=igtyp)
205 ENDIF
206 issn=0
207 ietyp = 100
208 geo(8,pid)=ietyp + em01
209 IF(geo(5,pid)/=zero)issn=1
210
211C
212 CALL zeroin(1,nparg,iparg(1,ngroup))
213C
214 ne1 = min( nvsiz, nel + nel_prec - nft)
215 nuvar =nint( geo(25,pid))
216 nuvarn=nint( geo(35,pid))
217
218 iparg(1,ngroup) = mtnn
219 iparg(2,ngroup) = ne1
220 iparg(3,ngroup) = ii-1
221 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
222c other groups using old buffer
223 iparg(5,ngroup) = ietyp
224 iparg(9,ngroup) = issn
225C flag for group of duplicated elements in multidomains
226 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
227C
228C reperage groupe/processeur
229 iparg(32,ngroup)= p-1
230 nft = nft + ne1
231 220 CONTINUE
232 ngp(p)=ngroup-ngp(p)
233 ENDIF
234 ENDDO
235cc LB_L = LBUFEL - LB_L
236cc LB_MAX = MAX(LB_MAX,LB_L)
237C DD_IAD => nb groupes par sous domaine
238 ngp(nspmd+1)=0
239 DO p = 1, nspmd
240 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
241 dd_iad(p,nspgroup+n)=ngp(p)
242 END DO
243 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
244C
245 300 CONTINUE
246C
247 nspgroup = nspgroup + nd
248C
249 WRITE(iout,1000)
250 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
251 + iparg(4,n),iparg(5,n),
252 + n=ngr1,ngroup)
253 WRITE(iout,1002) lbufel
254C
255 1000 FORMAT(10x,' 3D - MULTI-PURPOSE ELEMENT GROUPS '/
256 + 10x,' ----------------------------------'/
257 +' GROUP ELEMENT ELEMENT FIRST BUFFER ELEMENT '/
258 +' MATERIAL NUMBER ELEMENT ADDRESS TYPE '/)
259 1001 FORMAT(6(1x,i7,1x))
260 1002 FORMAT(' BUFFER LENGTH : ',i10 )
261C
262
263 RETURN
264 END
my_real
#define my_real
Definition cppsort.cpp:32
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
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
r2r_mod
Definition r2r_mod.F:125
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
starter
program starter
Definition starter.F:39
xgrtails
subroutine xgrtails(kxx, iparg, geo, eadd, nd, dd_iad, idx, lb_max, inum, index, cep, ipartx, itr1, igrsurf, ixx, igeo)
Definition xgrtails.F:39
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47