OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_s_eref.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine stat_s_eref (elbuf_tab, iparg, ipm, igeo, ixs, ixs10, ixs16, ixs20, x, dr, wa, wap0, iparts, ipart_state, stat_indxs, ipart, sizp0)
subroutine getconfig (ift, ilt, npe, ismstr, x0, y0, z0, sav, nel)

Function/Subroutine Documentation

◆ getconfig()

subroutine getconfig ( integer ift,
integer ilt,
integer npe,
integer ismstr,
x0,
y0,
z0,
double precision, dimension(nel,*) sav,
integer nel )

Definition at line 334 of file stat_s_eref.F.

335C-----------------------------------------------
336C I m p l i c i t T y p e s
337C-----------------------------------------------
338#include "implicit_f.inc"
339C-----------------------------------------------
340C G l o b a l P a r a m e t e r s
341C-----------------------------------------------
342#include "mvsiz_p.inc"
343C-----------------------------------------------
344C D u m m y A r g u m e n t s
345C-----------------------------------------------
346 INTEGER NPE,NEL,IFT,ILT,ISMSTR
347 my_real
348 . x0(mvsiz,*), y0(mvsiz,*), z0(mvsiz,*)
349 DOUBLE PRECISION
350 . SAV(NEL,*)
351C-----------------------------------------------
352C L o c a l V a r i a b l e s
353C-----------------------------------------------
354 INTEGER I,NPE1,N,N2,N3
355C-----------------------------------------------
356C
357 npe1=npe-1
358 IF (ismstr==1.AND.npe<10) THEN
359 DO n=1,npe1
360 n2 = 3*(n -1) +1
361 DO i=ift,ilt
362 x0(i,n)=sav(i,n2)
363 y0(i,n)=sav(i,n2+1)
364 z0(i,n)=sav(i,n2+2)
365 ENDDO
366 ENDDO
367 ELSEIF (npe<10) THEN
368 DO n=1,npe1
369 n2 = n + npe1
370 n3 = n2 + npe1
371 DO i=ift,ilt
372 x0(i,n)=sav(i,n)
373 y0(i,n)=sav(i,n2)
374 z0(i,n)=sav(i,n3)
375 ENDDO
376 ENDDO
377 END IF
378C---------diff stockage for quadratic elements
379 IF (npe>=10) THEN
380 DO n=1,npe
381 n2 = n + npe
382 n3 = n2 + npe
383 DO i=ift,ilt
384 x0(i,n) =sav(i,n)
385 y0(i,n) =sav(i,n2)
386 z0(i,n) =sav(i,n3)
387 ENDDO
388 ENDDO
389 ELSE
390 DO i=ift,ilt
391 x0(i,npe)=zero
392 y0(i,npe)=zero
393 z0(i,npe)=zero
394 ENDDO
395 END IF !(NPE==10) THEN
396C
397 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ stat_s_eref()

subroutine stat_s_eref ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
x,
dr,
double precision, dimension(*) wa,
double precision, dimension(*) wap0,
integer, dimension(*) iparts,
integer, dimension(*) ipart_state,
integer, dimension(*) stat_indxs,
integer, dimension(lipart1,*) ipart,
integer sizp0 )

Definition at line 39 of file stat_s_eref.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 USE my_alloc_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63#include "units_c.inc"
64#include "task_c.inc"
65#include "scr14_c.inc"
66#include "scr16_c.inc"
67#include "vect01_c.inc"
68#include "scr17_c.inc"
69#include "tabsiz_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER SIZLOC,SIZP0
74 INTEGER IXS(NIXS,*),IXS10(6,*),IXS16(8,*),IXS20(12,*),
75 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
76 . IPARTS(*), IPART_STATE(*), STAT_INDXS(*),IPART(LIPART1,*)
77 my_real
78 . x(3,*), dr(sdr)
79 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
80 double precision WA(*),WAP0(*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I,N,J,K,II,JJ,LEN,NLAY,NPTR,NPTS,NPTT,ISOLNOD0,
85 . ISOLNOD,ISTRAIN,NG, NEL, MLW, ID, IPRT0, IPRT,IE,
86 . NPG,IPG,IPT,IL,IR,IS,IT,IPID,PID,IOFF,KK(8),NC(20),
87 . NN1,NN,NSROT
88 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA
89 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA_P0
90 my_real x0(mvsiz,20), y0(mvsiz,20), z0(mvsiz,20)
91 CHARACTER*100 DELIMIT,LINE
92 DATA delimit(1:60)
93 ./'#---1----|----2----|----3----|----4----|----5----|----6----|'/
94 DATA delimit(61:100)
95 ./'----7----|----8----|----9----|----10---|'/
96C----
97 TYPE(L_BUFEL_) ,POINTER :: LBUF
98 TYPE(G_BUFEL_) ,POINTER :: GBUF
99C======================================================================|
100 CALL my_alloc(ptwa,stat_numels)
101 ALLOCATE(ptwa_p0(0:max(1,stat_numels_g)))
102C-----------------------------------------------
103 jj = 0
104 IF(stat_numels==0) GOTO 200
105
106 ie=0
107C----- not output all solid element
108 DO ng=1,ngroup
109 ity =iparg(5,ng)
110 isolnod = iparg(28,ng)
111 mlw =iparg(1,ng)
112 nel =iparg(2,ng)
113 nft =iparg(3,ng)
114 iad =iparg(4,ng)
115 istrain = iparg(44,ng)
116 lft = 1
117 llt = nel
118!
119 DO i=1,8 ! length max of GBUF%G_STRA = 8
120 kk(i) = nel*(i-1)
121 ENDDO
122!
123 IF (ity == 1) THEN
124 CALL initbuf(iparg ,ng ,
125 2 mlw ,nel ,nft ,iad ,ity ,
126 3 npt ,jale ,ismstr ,jeul ,jtur ,
127 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
128 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
129 6 irep ,iint ,igtyp ,israt ,isrot ,
130 7 icsen ,isorth ,isorthg ,ifailure,jsms )
131 IF (jhbe==17.AND.iint==2) jhbe = 18
132 IF (jhbe==1.AND.iint==3) jhbe = 5
133 isolnod0 = isolnod
134 nsrot = 0
135 IF (isolnod0==4 .AND. isrot==1) THEN
136 isolnod=10
137 nsrot = 4
138 END IF
139 gbuf => elbuf_tab(ng)%GBUF
140 iprt=iparts(lft+nft)
141 pid = ipart(2,iprt)
142c------
143 IF(ismstr==1.OR.ismstr>=10) THEN
144 CALL getconfig(lft,llt,isolnod,ismstr,x0,y0,z0,
145 1 gbuf%SMSTR,nel)
146 END IF
147 DO i=lft,llt
148 n = i + nft
149 iprt=iparts(n)
150 IF(ipart_state(iprt)==0)cycle
151 wa(jj+ 1)= iprt
152 wa(jj+ 2)= ixs(nixs,n)
153 wa(jj+ 3)= isolnod
154 wa(jj+ 4)= jhbe
155 wa(jj+ 5)= ismstr
156 wa(jj+ 6)= gbuf%OFF(i)
157 wa(jj+ 7)= nsrot
158 jj = jj + 7
159 IF(ismstr==1.OR.ismstr>=10) THEN
160 IF(isolnod == 8)THEN
161 DO j = 1,isolnod
162 nc(j) = ixs(j+1,n)
163 ENDDO
164 ELSEIF(isolnod0== 4)THEN
165 nc(1)=ixs(2,n)
166 nc(2)=ixs(4,n)
167 nc(3)=ixs(7,n)
168 nc(4)=ixs(6,n)
169 ELSEIF(isolnod == 6)THEN
170 nc(1)=ixs(2,n)
171 nc(2)=ixs(3,n)
172 nc(3)=ixs(4,n)
173 nc(4)=ixs(6,n)
174 nc(5)=ixs(7,n)
175 nc(6)=ixs(8,n)
176 ELSEIF(isolnod0== 10)THEN
177 nc(1)=ixs(2,n)
178 nc(2)=ixs(4,n)
179 nc(3)=ixs(7,n)
180 nc(4)=ixs(6,n)
181 nn1 = n - numels8
182 DO j=1,6
183 nc(j+4) = ixs10(j,nn1)
184 ENDDO
185 ELSEIF(isolnod == 16)THEN
186 nc(1:8) = ixs(2:9,n)
187 nn1 = n - (numels8+numels10+numels20)
188 DO j=1,8
189 nc(j+8) = ixs16(j,nn1)
190 ENDDO
191 ELSEIF(isolnod == 20)THEN
192 nc(1:8) = ixs(2:9,n)
193 nn1 = n - (numels8+numels10)
194 DO j=1,12
195 nc(j+8) = ixs20(j,nn1)
196 ENDDO
197 ENDIF
198 DO j= 1, isolnod
199 jj = jj + 1
200 wa(jj)= x0(i,j)
201 jj = jj + 1
202 wa(jj)= y0(i,j)
203 jj = jj + 1
204 wa(jj)= z0(i,j)
205 END DO
206 DO j= 1, nsrot
207 nn = 3*(nc(j)-1)
208 jj = jj + 1
209 wa(jj)= dr(1+nn)
210 jj = jj + 1
211 wa(jj)= dr(2+nn)
212 jj = jj + 1
213 wa(jj)= dr(3+nn)
214 END DO
215 END IF ! ISMSTR==1.OR.ISMSTR>=10
216 ie=ie+1
217C pointeur de fin de zone dans WA
218 ptwa(ie)=jj
219 END DO
220C
221 ENDIF ! ITY == 1
222 ENDDO ! NG=1,NGROUP
223 200 CONTINUE
224c-----------------------------------------------------------
225 IF(nspmd == 1)THEN
226C recopies inutiles pour simplification du code.
227 ptwa_p0(0)=0
228 DO n=1,stat_numels
229 ptwa_p0(n)=ptwa(n)
230 END DO
231 len=jj
232 DO j=1,len
233 wap0(j)=wa(j)
234 END DO
235 ELSE
236C construit les pointeurs dans le tableau global WAP0
237 CALL spmd_stat_pgather(ptwa,stat_numels,ptwa_p0,stat_numels_g)
238 len = 0
239 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
240 END IF
241c-----------------------------------------------------------
242 IF(ispmd == 0.AND.len>0) THEN
243
244 iprt0=0
245 DO n=1,stat_numels_g
246
247C retrouve le nieme elt dans l'ordre d'id croissant
248 k=stat_indxs(n)
249C retrouve l'adresse dans WAP0
250 j=ptwa_p0(k-1)
251 ioff = nint(wap0(j + 6))
252 iprt = nint(wap0(j + 1))
253 ismstr = nint(wap0(j + 5))
254 IF (ioff >= 1.AND.(ismstr==1.OR.ismstr>=10)) THEN
255 IF(iprt /= iprt0)THEN
256 IF (izipstrs == 0) THEN
257 WRITE(iugeo,'(A)') delimit
258 WRITE(iugeo,'(A)')'/INIBRI/EREF'
259 WRITE(iugeo,'(A)')
260 . '#------------------------ REPEAT -------------------------'
261 WRITE(iugeo,'(A)')
262 . '# BRICKID ISOLNOD ISOLID ISMSTR NSROT'
263 WRITE(iugeo,'(A/A)')
264 . '# REPEAT K=1,ISOLNOD ',
265 . '# X, Y, Z'
266 WRITE(iugeo,'(A)')
267 . '#------------------------ REPEAT -------------------------'
268 WRITE(iugeo,'(A)') delimit
269 ELSE
270 WRITE(line,'(A)') delimit
271 CALL strs_txt50(line,100)
272 WRITE(line,'(A)')'/INIBRI/EREF'
273 CALL strs_txt50(line,100)
274 WRITE(line,'(A)')
275 . '#------------------------ REPEAT -------------------------'
276 CALL strs_txt50(line,100)
277 WRITE(line,'(A)')
278 . '# BRICKID ISOLNOD ISOLID ISMSTR NSROT'
279 CALL strs_txt50(line,100)
280 WRITE(line,'(A)')
281 . '# REPEAT K=1,ISOLNOD '
282 CALL strs_txt50(line,100)
283 WRITE(line,'(A)')'# X, Y, Z'
284 CALL strs_txt50(line,100)
285 WRITE(line,'(A)')
286 . '# REPEAT K=1,NSROT '
287 CALL strs_txt50(line,100)
288 WRITE(line,'(A)')'# RX, RY, RZ'
289 CALL strs_txt50(line,100)
290 WRITE(line,'(A)')
291 . '#------------------------ REPEAT -------------------------'
292 CALL strs_txt50(line,100)
293 WRITE(line,'(A)') delimit
294 CALL strs_txt50(line,100)
295 END IF
296 iprt0=iprt
297 END IF
298 id = nint(wap0(j + 2))
299 isolnod = nint(wap0(j + 3))
300 jhbe = nint(wap0(j + 4))
301 nsrot = nint(wap0(j + 7))
302c
303 j = j + 7
304c------------------------------------------------
305 IF (izipstrs == 0) THEN
306 WRITE(iugeo,'(I10,10X,4I10)') id,isolnod,jhbe,ismstr,nsrot
307 ELSE
308 WRITE(line,'(I10,10X,4I10)') id,isolnod,jhbe,ismstr,nsrot
309 CALL strs_txt50(line,100)
310 ENDIF
311 DO ipt = 1, isolnod+nsrot
312 IF (izipstrs == 0) THEN
313 WRITE(iugeo,'(1P3E20.13)')(wap0(j + k),k=1,3)
314 ELSE
315 CALL tab_strs_txt50(wap0(1),3,j,sizp0,3)
316 ENDIF
317 j = j + 3
318 ENDDO
319 ENDIF ! IF (IOFF == 1)
320c---
321 ENDDO
322 ENDIF
323c-----------
324 DEALLOCATE(ptwa)
325 DEALLOCATE(ptwa_p0)
326c-----------
327 RETURN
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1015
spmd_stat_pgather
subroutine spmd_stat_pgather(ptv, ptlen, ptv_p0, ptlen_p0)
Definition spmd_stat.F:53
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87
tab_strs_txt50
subroutine tab_strs_txt50(wap0, cpt, j, sizp0, nbpline)
Definition sta_txt.F:127
getconfig
subroutine getconfig(ift, ilt, npe, ismstr, x0, y0, z0, sav, nel)
Definition stat_s_eref.F:335