OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_sp_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 "sphcom.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine outp_sp_s (nbx, key, text, elbuf_tab, iparg, eani, dd_iad, kxsp, ipm, spbuf, sizloc, sizp0, siz_wr)
subroutine count_arsz_sps (iparg, dd_iad, wasz, siz_write_loc)

Function/Subroutine Documentation

◆ count_arsz_sps()

subroutine count_arsz_sps ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer, dimension(nspgroup+1) siz_write_loc )

Definition at line 253 of file outp_sp_s.F.

254C-----------------------------------------------
255C I m p l i c i t T y p e s
256C-----------------------------------------------
257#include "implicit_f.inc"
258C-----------------------------------------------
259C C o m m o n B l o c k s
260C-----------------------------------------------
261#include "param_c.inc"
262#include "com01_c.inc"
263#include "task_c.inc"
264#include "scr16_c.inc"
265C-----------------------------------------------
266C D u m m y A r g u m e n t s
267C-----------------------------------------------
268 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,
269 . SIZ_WRITE_LOC(NSPGROUP+1)
270C-----------------------------------------------
271C L o c a l V a r i a b l e s
272C-----------------------------------------------
273 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,
274 . P0ARSZ2,WASZ2
275C-----------------------------------------------
276 wasz = 0
277
278 IF (outp_sps( 1) == 1.OR.outp_sps( 2) == 1.OR.
279 . outp_sps( 3) == 1.OR.outp_sps( 4) == 1.OR.
280 . outp_sps( 5) == 1.OR.outp_sps( 6) == 1.OR.
281 . outp_sps( 7) == 1.OR.outp_sps(25) == 1.OR.
282 . outp_sps(20) == 1.OR.outp_sps(21) == 1.OR.
283 . outp_sps(22) == 1.OR.outp_sps(23) == 1.OR.
284 . outp_sps(24) == 1 ) THEN
285
286 ngf = 1
287 ngl = 0
288 DO nn=1,nspgroup
289 jj = 0
290 ngl = ngl + dd_iad(ispmd+1,nn)
291 DO ng = ngf, ngl
292 ity =iparg(5,ng)
293 IF(ity == 51) THEN
294 nel = iparg(2,ng)
295 jj = jj + nel
296 ENDIF
297 ENDDO
298 ngf = ngl + 1
299 wasz = wasz + jj
300 siz_write_loc(nn) = jj
301 ENDDO
302 siz_write_loc(nspgroup+1) = wasz
303 ENDIF
304 RETURN

◆ outp_sp_s()

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

Definition at line 34 of file outp_sp_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 "sphcom.inc"
55#include "scr16_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 CHARACTER*10 KEY
60 CHARACTER*40 TEXT
61 INTEGER NBX,SIZLOC,SIZP0
62 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),
63 . KXSP(NISP,*), IPM(NPROPMI,*),SIZ_WR
64 my_real
65 . eani(*), spbuf(nspbuf,*)
66 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,J,II(6),JJ,N,NN,NG,NEL,MLW,JJ_OLD,NGF,NGL, LEN,WRTLEN,
71 . NUVAR,IUS,RESP0,RES,COMPTEUR,L,K
72 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
73 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
74 my_real
75 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
76 my_real
77 . func(6),s1 ,s2 ,s3,p,vonm2
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79 TYPE(BUF_MAT_) ,POINTER :: MBUF
80C=======================================================================
81 IF (ispmd == 0) THEN
82 WRITE(iugeo,'(2A)')'/SPHCEL /SCALAR /',key
83 WRITE(iugeo,'(A)')text
84 IF (outyy_fmt == 2) THEN
85 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5) (VAR(I),I=1,NUMSPH)'
86 ELSE
87 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13) (VAR(I),I=1,NUMSPH)'
88 END IF
89 ENDIF
90C
91 jj_old = 1
92 ngf = 1
93 ngl = 0
94 resp0=0
95 jj = 0
96 compteur = 0
97 DO nn=1,nspgroup
98 ngl = ngl + dd_iad(ispmd+1,nn)
99 DO ng = ngf, ngl
100 ity = iparg(5,ng)
101 IF (ity == 51) THEN
102 CALL initbuf(iparg ,ng ,
103 2 mlw ,nel ,nft ,iad ,ity ,
104 3 npt ,jale ,ismstr ,jeul ,jtur ,
105 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
106 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
107 6 irep ,iint ,igtyp ,israt ,isrot ,
108 7 icsen ,isorth ,isorthg ,ifailure,jsms )
109 lft=1
110 llt=nel
111 gbuf => elbuf_tab(ng)%GBUF
112 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
113 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT
114!
115 DO i=1,6
116 ii(i) = nel*(i-1)
117 ENDDO
118!
119C
120 DO i=lft,llt
121 jj = jj + 1
122 n = i + nft
123 wa(jj) = zero
124c
125 IF (nbx == -2) THEN ! Von Mises Stress
126 p = - (gbuf%SIG(ii(1)+i)
127 . + gbuf%SIG(ii(2)+i)
128 . + gbuf%SIG(ii(3)+i)) / three
129 s1 = gbuf%SIG(ii(1)+i) + p
130 s2 = gbuf%SIG(ii(2)+i) + p
131 s3 = gbuf%SIG(ii(3)+i) + p
132 vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +
133 . gbuf%SIG(ii(5)+i)**2 +
134 . gbuf%SIG(ii(6)+i)**2 +
135 . half*(s1*s1+s2*s2+s3*s3))
136 wa(jj)= sqrt(vonm2)
137 ELSEIF (nbx == 1) THEN ! OFF
138 wa(jj) = gbuf%OFF(i)
139 ELSEIF (nbx == 2) THEN ! pressure
140 wa(jj) = - (gbuf%SIG(ii(1)+i)
141 . + gbuf%SIG(ii(2)+i)
142 . + gbuf%SIG(ii(3)+i)) / three
143 ELSEIF (nbx == 3) THEN ! energy
144 wa(jj) = gbuf%EINT(i)
145 ELSEIF (nbx == 4) THEN ! density
146 wa(jj) = gbuf%RHO(i)
147 ELSEIF (nbx == 5 .and. gbuf%G_TEMP > 0) THEN ! temperature
148 wa(jj) = gbuf%TEMP(i)
149 ELSEIF (nbx == 10 .and. gbuf%G_PLA > 0) THEN ! plastic strain
150 wa(jj) = gbuf%PLA(i)
151 ELSEIF (nbx == 20 .and. nuvar >= 1) THEN ! USER1
152 wa(jj) = mbuf%VAR(i)
153 ELSEIF (nbx == 21 .and. nuvar >= 2) THEN ! USER2
154 ius = 1
155 wa(jj) = mbuf%VAR(ius*nel+i)
156 ELSEIF (nbx == 22 .and. nuvar >= 3) THEN ! USER3
157 ius = 2
158 wa(jj) = mbuf%VAR(ius*nel+i)
159 ELSEIF (nbx == 23 .and. nuvar >= 4) THEN ! USER4
160 ius = 3
161 wa(jj) = mbuf%VAR(ius*nel+i)
162 ELSEIF (nbx == 24 .and. nuvar >= 5) THEN ! USER5
163 ius = 4
164 wa(jj) = mbuf%VAR(ius*nel+i)
165 ELSEIF (nbx == 25) THEN
166 wa(jj) = spbuf(1,nft + i)
167 ELSEIF (nbx == 26) THEN
168C equivalent stress - (NON VON MISES / VON MISES)
169 IF (gbuf%G_SEQ > 0) THEN ! non VON MISES
170 wa(jj) = gbuf%SEQ(i)
171 ELSE ! VON MISES
172 p = - (gbuf%SIG(ii(1)+i)
173 . + gbuf%SIG(ii(2)+i)
174 . + gbuf%SIG(ii(3)+i)) / three
175 s1 = gbuf%SIG(ii(1)+i) + p
176 s2 = gbuf%SIG(ii(2)+i) + p
177 s3 = gbuf%SIG(ii(3)+i) + p
178 vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +
179 . gbuf%SIG(ii(5)+i)**2 +
180 . gbuf%SIG(ii(6)+i)**2 +
181 . half*(s1*s1+s2*s2+s3*s3))
182 wa(jj)= sqrt(vonm2)
183 ENDIF
184 ENDIF
185 ENDDO ! I=LFT,LLT
186 ENDIF
187 ENDDO ! NG = NGF, NGL
188c---
189 ngf = ngl + 1
190 jj_loc(nn) = jj - compteur ! size of each group
191 compteur = jj
192 ENDDO
193! ++++++++++
194 IF( nspmd>1 ) THEN
195 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
196 ELSE
197 wap0_loc(1:jj) = wa(1:jj)
198 adress(1,1) = 1
199 DO nn = 2,nspgroup+1
200 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
201 ENDDO
202 ENDIF
203! ++++++++++
204 IF(ispmd==0) THEN
205 resp0 = 0
206 DO nn=1,nspgroup
207 compteur = 0
208 DO k = 1,nspmd
209 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
210 DO l = adress(nn,k),adress(nn+1,k)-1
211 compteur = compteur + 1
212 wap0(compteur+resp0) = wap0_loc(l)
213 ENDDO ! l=... , ...
214 ENDIF !if(size_loc>0)
215 ENDDO ! k=1,nspmd
216
217 jj_old = compteur+resp0
218c---
219 IF(jj_old>0) THEN
220 res = mod(jj_old,6)
221 wrtlen = jj_old-res
222 IF (wrtlen > 0) THEN
223 IF (outyy_fmt == 2) THEN
224 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
225 ELSE
226 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
227 END IF
228 END IF
229 DO i=1,res
230 wap0(i)=wap0(wrtlen+i)
231 ENDDO
232 resp0=res
233 END IF
234 ENDDO ! nn=1,nspgroup
235
236 IF (resp0 > 0) THEN
237 IF (outyy_fmt == 2) THEN
238 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
239 ELSE
240 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
241 ENDIF
242 ENDIF
243 ENDIF ! ispmd=0
244c-----------
245 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