OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_s_s.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine outp_s_s (nbx, key, text, elbuf_tab, iparg, eani, ixs, ipm, dd_iad, sizloc, sizp0, siz_wr)
subroutine count_arsz_ss (iparg, dd_iad, ipm, ixs, wasz, siz_write_loc)

Function/Subroutine Documentation

◆ count_arsz_ss()

subroutine count_arsz_ss ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(npropmi,*) ipm,
integer, dimension(nixs,*) ixs,
integer, dimension(2) wasz,
integer, dimension(2*nspgroup+2) siz_write_loc )

Definition at line 400 of file outp_s_s.F.

401 use element_mod , only : nixs
402C-----------------------------------------------
403C I m p l i c i t T y p e s
404C-----------------------------------------------
405#include "implicit_f.inc"
406C-----------------------------------------------
407C C o m m o n B l o c k s
408C-----------------------------------------------
409#include "param_c.inc"
410#include "com01_c.inc"
411#include "scr16_c.inc"
412#include "task_c.inc"
413C-----------------------------------------------
414C D u m m y A r g u m e n t s
415C-----------------------------------------------
416 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ(2),
417 . IXS(NIXS,*),IPM(NPROPMI,*),SIZ_WRITE_LOC(2*NSPGROUP+2)
418C-----------------------------------------------
419C L o c a l V a r i a b l e s
420C-----------------------------------------------
421 INTEGER NN,NG,NGF,NGL,JJ,
422 . WASZ26,MLW,NEL,NPT,JHBE,ISOLNOD,
423 . NUVAR,I,LFT,LLT,NFT,ITY,WASZ1
424C-----------------------------------------------
425 wasz1 = 0
426
427 IF ( outp_ss(1) == 1.OR.outp_ss(2) == 1.OR.outp_ss(3) == 1
428 . .OR.outp_ss(4) == 1.OR.outp_ss(5) == 1.OR.outp_ss(6) == 1
429 . .OR.outp_ss(7) == 1.OR.outp_ss(25) == 1.OR.outp_ss(20) == 1
430 . .OR.outp_ss(21) == 1.OR.outp_ss(22) == 1.OR.outp_ss(23) == 1
431 . .OR.outp_ss(24) == 1 ) THEN
432
433 ngf = 1
434 ngl = 0
435 DO nn=1,nspgroup
436 jj = 0
437 ngl = ngl + dd_iad(ispmd+1,nn)
438 DO ng = ngf,ngl
439 nel = iparg(2,ng)
440 jj = jj + nel
441 ENDDO
442 wasz1 = wasz1+jj
443 ngf = ngl + 1
444 siz_write_loc(nn) = jj
445 ENDDO
446
447 ENDIF
448
449 wasz26 = 0
450 IF (outp_ss(26) == 1) THEN
451 ngf = 1
452 ngl = 0
453 DO nn=1,nspgroup
454 jj = 0
455 ngl = ngl + dd_iad(ispmd+1,nn)
456 DO ng = ngf,ngl
457 ity = iparg(5,ng)
458 IF (ity /= 1 .and. ity /= 2) cycle
459 mlw =iparg(1,ng)
460 nel = iparg(2,ng)
461 nft =iparg(3,ng)
462 npt = iabs(iparg(6,ng))
463 jhbe = iparg(23, ng)
464 isolnod = iabs(iparg(28,ng))
465 lft=1
466 llt=nel
467 nuvar = 0
468 IF (mlw >= 28) THEN
469
470 DO i=lft,llt
471 nuvar = max(nuvar,ipm(8,ixs(1,i+nft)))
472 ENDDO
473
474 IF(isolnod == 16.OR.isolnod == 20.OR.
475 . (isolnod == 8.AND.jhbe == 14))THEN
476 jj = jj+ (nuvar*npt+4)*nel
477 ELSEIF(isolnod == 10.OR.((isolnod == 6.OR.isolnod == 8).
478 . and.jhbe == 15).OR.jhbe == 12)THEN
479 jj = jj + (nuvar*abs(npt)+4)*nel
480 ELSEIF(npt > 1)THEN
481 jj = jj + (nuvar*npt+4)*nel
482 ELSE
483 jj = jj + (nuvar+4)*nel
484 ENDIF
485 ELSE
486cfor other types of material laws
487 jj = jj + 4 * nel
488 ENDIF
489
490 ENDDO
491 wasz26 = wasz26+jj
492 ngf = ngl + 1
493 siz_write_loc(nspgroup+nn) = jj
494 ENDDO
495 END IF
496 wasz(1) = wasz1
497 wasz(2) = wasz26
498 DO i=1,2
499 siz_write_loc(2*nspgroup+i) = wasz(i)
500 ENDDO
501
502 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ outp_s_s()

subroutine outp_s_s ( integer nbx,
character*10 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
eani,
integer, dimension(nixs,*) ixs,
integer, dimension(npropmi,*) ipm,
integer, dimension(nspmd+1,*) dd_iad,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 35 of file outp_s_s.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE initbuf_mod
42 USE elbufdef_mod
43 use element_mod , only : nixs
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "vect01_c.inc"
52#include "com01_c.inc"
53#include "param_c.inc"
54#include "units_c.inc"
55#include "task_c.inc"
56#include "scr16_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 CHARACTER*10 KEY
61 CHARACTER*40 TEXT
62 INTEGER NBX
63 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),
64 . IXS(NIXS,*),IPM(NPROPMI,*),SIZLOC,SIZP0,SIZ_WR
65 my_real
66 . eani(*)
67 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,J,II(6),JJ,RESP0,WRTLEN,RES
72 INTEGER NG, NEL,N,MLW,
73 . JJ_OLD, NGF, NGL, NN,NLAY, NUVAR, NPTT, NPTS,
74 . IUS, ISOLNOD,IL,IR,IS,IT,
75 . NPTR,K,COMPTEUR,L
76 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
77 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
78 my_real
79 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
80 my_real
81 . s1 ,s2 ,s3 ,p ,vonm2, user(200)
82 TYPE(BUF_LAY_) ,POINTER :: BUFLY
83 TYPE(L_BUFEL_) ,POINTER :: LBUF
84 TYPE(G_BUFEL_) ,POINTER :: GBUF
85 TYPE(BUF_MAT_) ,POINTER :: MBUF
86C=======================================================================
87 IF (ispmd == 0) THEN
88 WRITE(iugeo,'(2A)')'/SOLID /SCALAR /',key
89 WRITE(iugeo,'(A)')text
90 IF (outyy_fmt == 2) THEN
91 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5) (VAR(I),I=1,NUMSOL)'
92 ELSE
93 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13) (VAR(I),I=1,NUMSOL)'
94 ENDIF
95 ENDIF
96C
97 jj_old = 0
98 resp0=0
99 ngf = 1
100 ngl = 0
101 jj = 0
102 compteur = 0
103 DO nn=1,nspgroup
104 ngl = ngl + dd_iad(ispmd+1,nn)
105 DO ng = ngf, ngl
106 ity =iparg(5,ng)
107 IF (ity /= 1 .AND. ity /= 2) cycle
108 isolnod = iabs(iparg(28,ng))
109 nuvar = 0
110 CALL initbuf(iparg ,ng ,
111 2 mlw ,nel ,nft ,iad ,ity ,
112 3 npt ,jale ,ismstr ,jeul ,jtur ,
113 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
114 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
115 6 irep ,iint ,igtyp ,israt ,isrot ,
116 7 icsen ,isorth ,isorthg ,ifailure,jsms )
117c
118 bufly=> elbuf_tab(ng)%BUFLY(1)
119 gbuf => elbuf_tab(ng)%GBUF
120 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
121 nlay = elbuf_tab(ng)%NLAY
122 nptr = elbuf_tab(ng)%NPTR
123 npts = elbuf_tab(ng)%NPTS
124 nptt = elbuf_tab(ng)%NPTT
125 npt = nptr * npts * nptt * nlay
126 lft=1
127 llt=nel
128!
129 DO i=1,6
130 ii(i) = nel*(i-1)
131 ENDDO
132!
133c-------------------------------
134 IF(nbx == 2)THEN
135 DO i=lft,llt
136 jj = jj + 1
137 n = i + nft
138 wa(jj) = - (gbuf%SIG(ii(1)+i)
139 . + gbuf%SIG(ii(2)+i)
140 . + gbuf%SIG(ii(3)+i)) / three
141 ENDDO
142c-------------------------------
143 ELSEIF(nbx == -2)THEN
144 DO i=lft,llt
145 jj = jj + 1
146 n = i + nft
147 p = - (gbuf%SIG(ii(1)+i)
148 . + gbuf%SIG(ii(2)+i)
149 . + gbuf%SIG(ii(3)+i)) / three
150 s1 = gbuf%SIG(ii(1)+i) + p
151 s2 = gbuf%SIG(ii(2)+i) + p
152 s3 = gbuf%SIG(ii(3)+i) + p
153 vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +
154 . gbuf%SIG(ii(5)+i)**2 +
155 . gbuf%SIG(ii(6)+i)**2 +
156 . half*(s1*s1+s2*s2+s3*s3))
157 wa(jj)= sqrt(vonm2)
158 ENDDO
159c-------------------------------
160 ELSEIF(nbx>=20.AND.nbx<=24) THEN
161C variable user 1:5
162 IF(mlw>=28) THEN
163 DO i=lft,llt
164 nuvar = max(nuvar,ipm(8,ixs(1,i+nft)))
165 ENDDO
166 ius = nbx - 20
167 DO i=lft,llt
168 jj = jj + 1
169 n = i + nft
170 user(i) = zero
171 DO il=1,nlay
172 DO ir=1,nptr
173 DO is=1,npts
174 DO it=1,nptt
175 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
176 IF (nuvar>ius) user(i) = user(i) +
177 . mbuf%VAR(ius*nel+i)/npt
178 ENDDO
179 ENDDO
180 ENDDO
181 ENDDO
182 wa(jj) = user(i)
183 ENDDO
184 ELSE ! non user laws
185 DO i=lft,llt
186 jj = jj + 1
187 n = i + nft
188 wa(jj)= zero
189 ENDDO
190 ENDIF
191c-------------------------------
192 ELSEIF (nbx == 26) THEN
193 IF (mlw >= 28) THEN
194 DO i=lft,llt
195 nuvar = max(nuvar,ipm(8,ixs(1,i+nft)))
196 ENDDO
197c
198 DO i=lft,llt
199 wa(jj+ 1 ) = isolnod
200 wa(jj+ 2 ) = npt
201 wa(jj+ 3 ) = nuvar
202 wa(jj+ 4 ) = iabs(jhbe)
203 jj = jj + 4
204 n = i + nft
205 DO il=1,nlay
206 DO ir=1,nptr
207 DO is=1,npts
208 DO it=1,nptt
209 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
210 DO ius = 1,nuvar
211 jj = jj +1
212 wa(jj) = mbuf%VAR(ius + (i-1)*nuvar)
213 ENDDO
214 ENDDO
215 ENDDO
216 ENDDO
217 ENDDO
218 ENDDO
219c
220 ELSE ! Laws not user
221 DO i=lft,llt
222 wa(jj+ 1 ) = isolnod
223 wa(jj+ 2 ) = npt
224 wa(jj+ 3 ) = nuvar
225 wa(jj+ 4 ) = iabs(jhbe)
226 jj = jj + 4
227 ENDDO
228 ENDIF
229c-------------------------------
230 ELSEIF(nbx == 25)THEN
231 DO i=lft,llt
232 jj = jj +1
233 wa(jj)=eani(nft + i)
234 ENDDO
235c-------------------------------
236 ELSEIF (nbx == 1) THEN
237 DO i=lft,llt
238 jj = jj + 1
239 wa(jj)=gbuf%OFF(i)
240 ENDDO
241c-------------------------------
242 ELSEIF (nbx == 3) THEN
243 DO i=lft,llt
244 jj = jj + 1
245 wa(jj)=gbuf%EINT(i)
246 ENDDO
247c-------------------------------
248 ELSEIF (nbx == 4) THEN
249 DO i=lft,llt
250 jj = jj + 1
251 wa(jj)=gbuf%RHO(i)
252 ENDDO
253c-------------------------------
254 ELSEIF (nbx == 10) THEN
255 IF (bufly%L_PLA == 0) THEN
256 DO i=lft,llt
257 jj = jj + 1
258 wa(jj)=zero
259 ENDDO
260 ELSE
261 DO i=lft,llt
262 jj = jj + 1
263 wa(jj)=lbuf%PLA(i)
264 ENDDO
265 ENDIF
266c-------------------------------
267 ELSEIF (nbx == 11) THEN
268 IF (bufly%L_TEMP == 0) THEN
269 DO i=lft,llt
270 jj = jj + 1
271 wa(jj)=zero
272 ENDDO
273 ELSE
274 DO i=lft,llt
275 jj = jj + 1
276 wa(jj)=gbuf%TEMP(i)
277 ENDDO
278 ENDIF
279c-------------------------------
280 ELSEIF (nbx == 27) THEN
281C equivalent stress - other then VON MISES
282 IF (gbuf%G_SEQ > 0) THEN
283 DO i=lft,llt
284 jj = jj + 1
285 wa(jj) = gbuf%SEQ(i)
286 ENDDO
287 ELSE ! VON MISES
288 DO i=lft,llt
289 jj = jj + 1
290 n = i + nft
291 p = - (gbuf%SIG(ii(1)+i)
292 . + gbuf%SIG(ii(2)+i)
293 . + gbuf%SIG(ii(3)+i)) / three
294 s1 = gbuf%SIG(ii(1)+i) + p
295 s2 = gbuf%SIG(ii(2)+i) + p
296 s3 = gbuf%SIG(ii(3)+i) + p
297 vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +
298 . gbuf%SIG(ii(5)+i)**2 +
299 . gbuf%SIG(ii(6)+i)**2 +
300 . half*(s1*s1+s2*s2+s3*s3))
301 wa(jj)= sqrt(vonm2)
302 ENDDO
303 ENDIF
304 ENDIF
305c-------------------------------
306 ENDDO
307c-------------------------------
308 ngf = ngl + 1
309 jj_loc(nn) = jj - compteur
310 compteur = jj
311 ENDDO ! fin nspgroup
312! ++++++++++
313 IF( nspmd>1 ) THEN
314 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
315 ELSE
316 wap0_loc(1:jj) = wa(1:jj)
317 adress(1,1) = 1
318 DO nn = 2,nspgroup+1
319 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
320 ENDDO
321 ENDIF
322! ++++++++++
323 IF(ispmd==0) THEN
324 resp0 = 0
325
326 DO nn=1,nspgroup
327 compteur = 0
328 DO k = 1,nspmd
329 IF((adress(nn+1,k)-adress(nn,k)-1)>=0) THEN
330 DO l = adress(nn,k),adress(nn+1,k)-1
331 compteur = compteur + 1
332 wap0(compteur+resp0) = wap0_loc(l)
333 ENDDO ! l=... , ...
334 ENDIF !if(size_loc>0)
335 ENDDO ! k=1,nspmd
336
337 jj_old = compteur+resp0
338 IF(jj_old>0) THEN
339 IF( nbx == 26) THEN
340 j = 0
341 DO WHILE(j<jj_old)
342 isolnod= nint(wap0(j + 1))
343 npt = nint(wap0(j + 2))
344 nuvar = nint(wap0(j + 3))
345 jhbe = nint(wap0(j + 4))
346 j = j + 4
347 IF (outyy_fmt == 2) THEN
348 WRITE(iugeo,'(4I8)') isolnod,npt,nuvar,jhbe
349 ELSE
350 WRITE(iugeo,'(4I10)')isolnod,npt,nuvar,jhbe
351 ENDIF
352 IF (nuvar/=0) THEN
353 DO i = 1,npt
354 IF(outyy_fmt == 2)THEN
355 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k),k=1,nuvar)
356 ELSE
357 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k),k=1,nuvar)
358 ENDIF
359 j = j + nuvar
360 ENDDO
361 ENDIF
362 ENDDO
363 ELSE
364 res=mod(jj_old,6)
365 wrtlen=jj_old-res
366 IF (wrtlen>0) THEN
367 IF (outyy_fmt == 2) THEN
368 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
369 ELSE
370 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
371 ENDIF
372 ENDIF
373 DO i=1,res
374 wap0(i)=wap0(wrtlen+i)
375 ENDDO
376 resp0=res
377 ENDIF ! nbx= 26
378 ENDIF ! JJ_OLD>0
379 ENDDO ! nn = 1, nspgroup
380c
381 IF (resp0>0) THEN
382 IF (outyy_fmt == 2) THEN
383 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
384 ELSE
385 WRITE(iugeo,'(1p6e20.13)')(WAP0(J),J=1,RESP0)
386 ENDIF
387 ENDIF
388 ENDIF ! ispmd = 0
389c-----------
390 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1181