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 396 of file outp_s_s.F.

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

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