OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_s_s.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!|| outp_s_s ../engine/source/output/sty/outp_s_s.F
25!||--- called by ------------------------------------------------------
26!|| genoutp ../engine/source/output/sty/genoutp.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| spmd_rgather9_1comm ../engine/source/mpi/interfaces/spmd_outp.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!||====================================================================
34 SUBROUTINE outp_s_s(NBX ,KEY ,TEXT ,ELBUF_TAB,
35 . IPARG ,EANI ,IXS ,IPM ,DD_IAD ,
36 . SIZLOC ,SIZP0 ,SIZ_WR)
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
389 END
390!||====================================================================
391!|| count_arsz_ss ../engine/source/output/sty/outp_s_s.F
392!||--- called by ------------------------------------------------------
393!|| genoutp ../engine/source/output/sty/genoutp.F
394!|| outp_arsz_ss ../engine/source/mpi/interfaces/spmd_outp.f
395!||====================================================================
396 SUBROUTINE count_arsz_ss(IPARG,DD_IAD,IPM,IXS,WASZ,SIZ_WRITE_LOC)
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
498 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
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
outp_s_s
subroutine outp_s_s(nbx, key, text, elbuf_tab, iparg, eani, ixs, ipm, dd_iad, sizloc, sizp0, siz_wr)
Definition outp_s_s.F:37
count_arsz_ss
subroutine count_arsz_ss(iparg, dd_iad, ipm, ixs, wasz, siz_write_loc)
Definition outp_s_s.F:397
outp_arsz_ss
subroutine outp_arsz_ss(iparg, dd_iad, ipm, ixs, p0ars, wasz, wasz_wr)
Definition spmd_outp.F:36
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1177