OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spgrtails.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spgrtails (kxsp, iparg, pm, ipart, ipartsp, eadd, nd, cepsp, dd_iad, idx, ixsp, ipm, igeo, spbuf, sph2sol, sol2sph, irst, nod2sp, print_flag, mat_param, ixsps)

Function/Subroutine Documentation

◆ spgrtails()

subroutine spgrtails ( integer, dimension(nisp,*) kxsp,
integer, dimension(nparg,*) iparg,
pm,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartsp,
integer, dimension(*) eadd,
integer nd,
integer, dimension(*) cepsp,
integer, dimension(nspmd+1,*) dd_iad,
integer idx,
integer, dimension(kvoisph,numsph) ixsp,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
spbuf,
integer, dimension(*) sph2sol,
integer, dimension(2,*) sol2sph,
integer, dimension(3,*) irst,
integer, dimension(*) nod2sp,
integer, intent(in) print_flag,
type(matparam_struct_), dimension(nummat), intent(in) mat_param,
integer, dimension(kvoisph,numsph), intent(inout) ixsps )
Parameters
[in]print_flagflag to print the element group data

Definition at line 36 of file spgrtails.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE my_alloc_mod
46 USE message_mod
47 USE r2r_mod
48 USE matparam_def_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "vect01_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "sphcom.inc"
61#include "units_c.inc"
62#include "param_c.inc"
63#include "scr17_c.inc"
64#include "r2r_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, DIMENSION(KVOISPH,NUMSPH),INTENT(INOUT) :: IXSPS
69 INTEGER IDX,ND,
70 . KXSP(NISP,*),IPARG(NPARG,*),DD_IAD(NSPMD+1,*),EADD(*),
71 . IPART(LIPART1,*),IPARTSP(*),CEPSP(*),IXSP(KVOISPH,NUMSPH),
72 . IPM(NPROPMI,*), IGEO(NPROPGI,*),
73 . SPH2SOL(*), SOL2SPH(2,*), IRST(3,*), NOD2SP(*)
74 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
75 my_real
76 . pm(npropm,*), spbuf(nspbuf,numsph)
77 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT), INTENT(IN) :: MAT_PARAM
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER NGR1, NG, MT, MLN, I, P, NEL, MODE, NB,
82 . N, IGTYP,JIVF,JHBE,IJK,NE1,
83 . ISSN,IKSNOD,IORDER,IPRT,ISLEEP,IEOS,NEL_PREC,IUN,IG,IFAIL,
84 . WORK(70000),NGP(NSPMD+1),K,J,II, MX, NFAIL, IR, IP, STAT,
85 . IPARTR2R, NOD, JALE_FROM_MAT, JALE_FROM_PROP
86 INTEGER, DIMENSION(:,:),ALLOCATABLE :: INUM
87 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
88 my_real, DIMENSION(:,:),ALLOCATABLE :: rnum
89
90 INTEGER ID
91 CHARACTER(LEN=NCHARTITLE)::TITR
92 DATA iun/1/
93C-----------------------------------------------
94C E x t e r n a l F u n c t i o n s
95C-----------------------------------------------
96 my_real
97 . get_u_geo
98 EXTERNAL get_u_geo
99C--------------------------------------------------------------
100C BORNAGE DES GROUPES DE MVSIZ
101C--------------------------------------------------------------
102 CALL my_alloc(inum,13,numsph)
103 CALL my_alloc(index,2*numsph)
104 CALL my_alloc(rnum,nspbuf,numsph)
105 nel = 0
106 DO n=1,nd
107 nel = nel + eadd(n+1)-eadd(n)
108 ENDDO
109 ngr1 = ngroup + 1
110C
111C phase 1 : domain decompostition
112C
113 idx=idx+nd*(nspmd+1)
114 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
115C NSPGROUP = NSPGROUP + ND
116 nft = 0
117C initialisation dd_iad
118 DO n=1,nd
119 DO p=1,nspmd+1
120 dd_iad(p,nspgroup+n) = 0
121 END DO
122 END DO
123C
124 DO n=1,nd
125 nel = eadd(n+1)-eadd(n)
126 DO i = 1, nel
127 index(i) = i
128 inum(1,i)=ipartsp(nft+i)
129 inum(2,i)=kxsp(1,nft+i)
130 inum(3,i)=kxsp(2,nft+i)
131 inum(4,i)=kxsp(3,nft+i)
132 inum(5,i)=kxsp(4,nft+i)
133 inum(6,i)=kxsp(5,nft+i)
134 inum(7,i)=kxsp(6,nft+i)
135 inum(8,i)=kxsp(7,nft+i)
136 inum(9,i)=kxsp(8,nft+i)
137c retri spbuf
138 DO k=1,nspbuf
139 rnum(k,i)=spbuf(k,nft+i)
140 END DO
141 END DO
142
143 DO i = 1, nel
144 DO j = 1, kvoisph
145 ixsps(j,i) = ixsp(j,nft+i)
146 END DO
147 END DO
148 mode=0
149 CALL my_orders( mode, work, cepsp(nft+1), index, nel , 1)
150 DO i = 1, nel
151 ipartsp(i+nft)=inum(1,index(i))
152 kxsp(1,i+nft)=inum(2,index(i))
153 kxsp(2,i+nft)=inum(3,index(i))
154 kxsp(3,i+nft)=inum(4,index(i))
155 kxsp(4,i+nft)=inum(5,index(i))
156 kxsp(5,i+nft)=inum(6,index(i))
157 kxsp(6,i+nft)=inum(7,index(i))
158 kxsp(7,i+nft)=inum(8,index(i))
159 kxsp(8,i+nft)=inum(9,index(i))
160
161c tri SPBUF
162 DO k=1,nspbuf
163 spbuf(k,i+nft)=rnum(k,index(i))
164 END DO
165 END DO
166
167 DO i = 1, nel
168 DO j = 1, kvoisph
169 ixsp(j,i+nft) = ixsps(j,index(i))
170 END DO
171 END DO
172C
173 IF(nsphsol/=0)THEN
174 DO i=1,nel
175 inum(10,i)=sph2sol(nft+i)
176 IF(nft+i >= first_sphsol .AND.
177 . nft+i < first_sphsol+nsphsol)THEN
178 inum(11,i)=irst(1,nft+i-first_sphsol+1)
179 inum(12,i)=irst(2,nft+i-first_sphsol+1)
180 inum(13,i)=irst(3,nft+i-first_sphsol+1)
181 END IF
182 END DO
183 DO i=1,nel
184 sph2sol(nft+i) = inum(10,index(i))
185C
186 IF(nft+i >= first_sphsol .AND.
187 . nft+i < first_sphsol+nsphsol)THEN
188C INDEX(I) < FIRST_SPHSOL <=> internal error
189 irst(1,nft+i-first_sphsol+1)=inum(11,index(i))
190 irst(2,nft+i-first_sphsol+1)=inum(12,index(i))
191 irst(3,nft+i-first_sphsol+1)=inum(13,index(i))
192 END IF
193 END DO
194 END IF
195C
196 p = cepsp(nft+index(1))
197 nb = 1
198 DO i = 2, nel
199 IF (cepsp(nft+index(i))/=p) THEN
200 dd_iad(p+1,nspgroup+n) = nb
201 nb = 1
202 p = cepsp(nft+index(i))
203 ELSE
204 nb = nb + 1
205 ENDIF
206 END DO
207 dd_iad(p+1,nspgroup+n) = nb
208 DO p = 2, nspmd
209 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
210 . + dd_iad(p-1,nspgroup+n)
211 END DO
212 DO p = nspmd+1,2,-1
213 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
214 END DO
215 dd_iad(1,nspgroup+n) = 1
216C
217C maj CEP
218C
219 DO i = 1, nel
220 index(i) = cepsp(nft+index(i))
221 END DO
222 DO i = 1, nel
223 cepsp(nft+i) = index(i)
224 END DO
225C
226 nft = nft + nel
227C
228 END DO
229C
230C Rebuild SOL2SPH, SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
231 IF(nsphsol/=0)THEN
232 DO n=1,numels8
233 sol2sph(1,n)=0
234 sol2sph(2,n)=0
235 END DO
236 n=sph2sol(first_sphsol)
237 sol2sph(1,n)=first_sphsol-1
238 sol2sph(2,n)=sol2sph(1,n)+1
239 DO i=first_sphsol+1,first_sphsol+nsphsol-1
240 IF(sph2sol(i)==n)THEN
241 sol2sph(2,n)=sol2sph(2,n)+1
242 ELSE
243 n=sph2sol(i)
244 sol2sph(1,n)=i-1
245 sol2sph(2,n)=sol2sph(1,n)+1
246 END IF
247 END DO
248 END IF
249C ne pas oublier renumeroter selection th et surface si concerne
250C
251C
252C phase 2 : bornage en groupe de mvsiz
253C ngroup est global, iparg est global mais organise en fonction de dd
254C
255 jale=0
256 jeul=0
257 jtur=0
258 jthe=0
259 jivf=0
260 jpor=0
261C
262 issn =0
263 npt =1
264 iksnod =1
265 jhbe =0
266C
267 DO n=1,nd
268 nft = 0
269 DO p = 1, nspmd
270 ngp(p)=0
271 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
272 IF (nel>0) THEN
273 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
274 ngp(p)=ngroup
275 ng = (nel-1)/nvsiz + 1
276 DO i=1,ng
277C ngroup global
278 istrain=0
279 ngroup=ngroup+1
280 ii = eadd(n)+nft
281 iprt =ipartsp(ii)
282 ipartr2r = 0
283 IF (nsubdom>0) ipartr2r = tag_part(iprt)
284 mt =ipart(1,iprt)
285 mln =nint(pm(19,abs(mt)))
286 ig =ipart(2,iprt)
287 igtyp = igeo(11,ig)
288 isorth= max(igeo(17,ig),min(iun,igeo(2,ig)))
289 israt = ipm(3,mt)
290 ieos = ipm(4,mt)
291 iorder=int(get_u_geo(5,ig))
292 isleep=kxsp(2,ii)
293
294 jale_from_mat = nint(pm(72,mt))
295 jale_from_prop = igeo(62,ig)
296 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
297
298 jlag=0
299 IF(jale==0.AND.mln/=18)jlag=1
300 jeul=0
301 IF(jale==2)THEN
302 jale=0
303 jeul=1
304 ENDIF
305
306 !ALE UVAR REZONING (81:MAT, 82:EOS)
307 ! n/a with SPH
308 iparg(81,ngroup) = 0
309 iparg(82,ngroup) = 0
310
311
312 IF (jale+jeul/=0) THEN
313C WRITE(ISTDO,*) ' ** ERROR : BAD ANALYSIS TYPE'
314C WRITE(IOUT,*) ' ** ERROR : BAD ANALYSIS TYPE'
315C WRITE(IOUT,*) ' ** ERROR : ALE AND EULERIAN ANALYSIS',
316C . ' ARE NOT COMPATIBLE WITH SPH.'
317C IERR=IERR+1
318 id=igeo(1,ig)
319 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
320 CALL ancmsg(msgid=403,
321 . msgtype=msgerror,
322 . anmode=aninfo_blind_1,
323 . i1=id,
324 . c1=titr)
325 ENDIF
326 jtur=nint(pm(70,mt))
327 jthe=nint(pm(71,mt))
328
329 isph2sol=0
330 IF(nsphsol/=0)isph2sol=sph2sol(ii)
331C full geometric non linearities.
332 ne1 = min( nvsiz, nel + nel_prec - nft)
333 ifail = 0
334 IF (mat_param(mt)%NFAIL > 0) ifail = 1
335C-------------------------------------------------
336 IF(mln/=14 .AND. mln/=24 .AND. mln/=25 .AND. mln<28) THEN
337 nfail = mat_param(mt)%NFAIL
338 DO ijk = 1, ne1
339 ii = eadd(n)+nft-1+ijk
340 mx = ipart(1,ipartsp(ii))
341 DO ir = 1,nfail
342 IF (mat_param(mx)%FAIL(ir)%IRUPT == 10) THEN
343 istrain=1
344 GO TO 100
345 END IF
346 END DO
347 END DO
348 100 CONTINUE
349 ENDIF
350C-------------------------------------------------
351 DO ijk = 1, ne1
352C
353C Attention, penser a sauvegarder KXSP(2) si besoin (backtrack spmd si interface)
354C
355 kxsp(2,eadd(n)-1+nft+ijk)=
356 . sign(ngroup,isleep)
357 END DO
358 IF (mt/=0) THEN
359 iparg(1,ngroup)=mln
360 ELSE
361 iparg(1,ngroup)=igtyp
362 END IF
363 iparg(2,ngroup)=ne1
364 iparg(3,ngroup)=eadd(n)-1 + nft
365 iparg(4,ngroup)=lbufel+1
366 iparg(5,ngroup)=51
367 iparg(6,ngroup)=npt
368 iparg(7,ngroup) =jale
369 IF(isleep==-1.OR.isph2sol/=0)iparg(8,ngroup) =1
370 iparg(9,ngroup) =issn
371 IF(isleep>0)iparg(10,ngroup)=ne1
372 iparg(11,ngroup)=jeul
373 iparg(12,ngroup)=jtur
374 iparg(13,ngroup)=-abs(jthe)
375 iparg(14,ngroup)=jlag
376 iparg(18,ngroup)=0 ! NMTV(MLN)-11
377 iparg(23,ngroup)=jhbe
378 iparg(24,ngroup)=jivf
379 iparg(27,ngroup)=jpor
380 iparg(28,ngroup)=iksnod
381 iparg(32,ngroup)= p-1
382 iparg(38,ngroup)=igtyp
383 iparg(40,ngroup)=israt
384 iparg(42,ngroup)=isorth
385 iparg(43,ngroup)=ifail
386 iparg(62,ngroup)=ig
387 iparg(69,ngroup)=isph2sol
388
389C flag for group of duplicated elements in multidomains
390 IF (nsubdom>0) iparg(71,ngroup)= ipartr2r
391C thermal expansion
392 IF(ipm(218,mt) > 0 .AND. mln /= 0 .AND. mln /= 13) iparg(49,ngroup)= 1
393C
394 IF(mln/=14.AND.mln/=24.AND.mln/=25.AND.mln<28)THEN
395 iparg(44,ngroup)= istrain
396 ELSEIF(mln>=28)THEN
397 istrain=2
398 iparg(44,ngroup)=istrain
399 ENDIF
400C
401C equation of state
402 iparg(55,ngroup)= ieos
403 nft = nft + ne1
404 ENDDO
405 ngp(p)=ngroup-ngp(p)
406 ENDIF
407 ENDDO
408C DD_IAD => nb groupes par sous domaine
409 ngp(nspmd+1)=0
410 DO p = 1, nspmd
411 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
412 dd_iad(p,nspgroup+n)=ngp(p)
413 END DO
414 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
415C
416 END DO
417 nspgroup = nspgroup + nd
418C
419 ! rebuild NOD2SP after KXSP renumerotation
420 nod2sp(1:numnod) = 0
421 DO i = 1, numsph
422 nod = kxsp(3,i)
423 nod2sp(nod) = i
424 END DO
425C
426 IF(print_flag>6) THEN
427 WRITE(iout,1000)
428 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
429 + iparg(4,n),iparg(5,n),iparg(55,n),
430 + n=ngr1,ngroup)
431 ENDIF
432C
433 1000 FORMAT(10x,' 3D - SPH CELL GROUPS '/
434 + 10x,' -------------------- '/
435 +' GROUP CELL CELL FIRST BUFFER CELL IEOS'/
436 +' MATERIAL NUMBER CELL ADDRESS TYPE TYPE'/)
437 1001 FORMAT(7(1x,i7,1x))
438C-----------
439 DEALLOCATE(inum)
440 DEALLOCATE(index)
441 DEALLOCATE(rnum)
442C-----------
443 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
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_part
integer, dimension(:), allocatable tag_part
Definition r2r_mod.F:134
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
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47