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

Go to the source code of this file.

Functions/Subroutines

subroutine outp_sp_t (key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
subroutine outp_sp_tt (key, text, elbuf_tab, iparg, dd_iad, ipm, kxsp, spbuf, sizloc, sizp0, siz_wr)
subroutine count_arsz_spt (iparg, dd_iad, wasz, siz_write_loc)
subroutine count_arsz_sptt (iparg, dd_iad, wasz, siz_write_loc)

Function/Subroutine Documentation

◆ count_arsz_spt()

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

Definition at line 361 of file outp_sp_t.F.

362C-----------------------------------------------
363C I m p l i c i t T y p e s
364C-----------------------------------------------
365#include "implicit_f.inc"
366C-----------------------------------------------
367C C o m m o n B l o c k s
368C-----------------------------------------------
369#include "param_c.inc"
370#include "com01_c.inc"
371#include "task_c.inc"
372#include "scr16_c.inc"
373C-----------------------------------------------
374C D u m m y A r g u m e n t s
375C-----------------------------------------------
376 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,SIZ_WRITE_LOC(NSPGROUP+1)
377C-----------------------------------------------
378C L o c a l V a r i a b l e s
379C-----------------------------------------------
380 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,
381 . P0ARSZ2,WASZ2
382C-----------------------------------------------
383 wasz = 0
384 IF (outp_spt( 1) == 1 ) THEN
385
386 ngf = 1
387 ngl = 0
388 DO nn=1,nspgroup
389 jj = 0
390 ngl = ngl + dd_iad(ispmd+1,nn)
391 DO ng = ngf, ngl
392 ity =iparg(5,ng)
393 IF(ity == 51) THEN
394 nel = iparg(2,ng)
395 jj = jj + 6*nel
396 ENDIF
397 ENDDO
398 ngf = ngl + 1
399 wasz = wasz + jj
400 siz_write_loc(nn) = jj
401 ENDDO
402 siz_write_loc(nspgroup+1) = wasz
403
404 ENDIF
405
406 RETURN

◆ count_arsz_sptt()

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

Definition at line 414 of file outp_sp_t.F.

415C-----------------------------------------------
416C I m p l i c i t T y p e s
417C-----------------------------------------------
418#include "implicit_f.inc"
419C-----------------------------------------------
420C C o m m o n B l o c k s
421C-----------------------------------------------
422#include "param_c.inc"
423#include "com01_c.inc"
424#include "task_c.inc"
425#include "scr16_c.inc"
426C-----------------------------------------------
427C D u m m y A r g u m e n t s
428C-----------------------------------------------
429 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,SIZ_WRITE_LOC(NSPGROUP+1)
430C-----------------------------------------------
431C L o c a l V a r i a b l e s
432C-----------------------------------------------
433 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,
434 . P0ARSZ2,WASZ2
435C-----------------------------------------------
436 wasz = 0
437 IF (outp_spt( 1) == 1 ) THEN
438
439 ngf = 1
440 ngl = 0
441 DO nn=1,nspgroup
442 jj = 0
443 ngl = ngl + dd_iad(ispmd+1,nn)
444 DO ng = ngf, ngl
445 ity =iparg(5,ng)
446 IF(ity == 51) THEN
447 nel = iparg(2,ng)
448 jj = jj + 11*nel
449 ENDIF
450 ENDDO
451 ngf = ngl + 1
452 wasz = wasz + jj
453 siz_write_loc(nn) = jj
454 ENDDO
455 siz_write_loc(nspgroup+1) = wasz
456 ENDIF
457 RETURN

◆ outp_sp_t()

subroutine outp_sp_t ( character*10 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 34 of file outp_sp_t.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE initbuf_mod
39 USE elbufdef_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "vect01_c.inc"
48#include "com01_c.inc"
49#include "param_c.inc"
50#include "units_c.inc"
51#include "task_c.inc"
52#include "scr16_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 CHARACTER*10 KEY
57 CHARACTER*40 TEXT
58 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),
59 . SIZLOC,SIZP0,SIZ_WR
60 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,J,NG,NEL,N,II(6),JJ,JJ_OLD, NGF, NGL, NN,
65 . LEN,RESP0,WRTLEN,RES,COMPTEUR,L,K
66 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
67 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
68 my_real
69 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
70 my_real
71 . func(6)
72 TYPE(G_BUFEL_) ,POINTER :: GBUF
73C=======================================================================
74 IF (ispmd == 0) THEN
75 WRITE(iugeo,'(2A)')'/SPHCEL /TENSOR /',key
76 WRITE(iugeo,'(A)')text
77 IF (outyy_fmt == 2) THEN
78 WRITE(iugeo,'(2A)') '#FORMAT: (1P6E12.5) ',
79 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),I=1,NUMSPH)'
80 ELSE
81 WRITE(iugeo,'(2A)') '#FORMAT: (1P6E20.13) ',
82 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),I=1,NUMSPH)'
83 END IF
84 END IF
85C
86 jj_old = 1
87 ngf = 1
88 ngl = 0
89 resp0=0
90 jj = 0
91 compteur = 0
92 DO nn=1,nspgroup
93 ngl = ngl + dd_iad(ispmd+1,nn)
94 DO ng = ngf, ngl
95 ity =iparg(5,ng)
96 IF(ity == 51) THEN
97 CALL initbuf(iparg ,ng ,
98 2 mtn ,nel ,nft ,iad ,ity ,
99 3 npt ,jale ,ismstr ,jeul ,jtur ,
100 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
101 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
102 6 irep ,iint ,igtyp ,israt ,isrot ,
103 7 icsen ,isorth ,isorthg ,ifailure,jsms )
104 gbuf => elbuf_tab(ng)%GBUF
105 lft=1
106 llt=nel
107!
108 DO i=1,6
109 ii(i) = nel*(i-1)
110 ENDDO
111!
112 DO i=lft,llt
113 wa(jj+(i-1)*6+1) = gbuf%SIG(ii(1)+i)
114 wa(jj+(i-1)*6+2) = gbuf%SIG(ii(2)+i)
115 wa(jj+(i-1)*6+3) = gbuf%SIG(ii(3)+i)
116 wa(jj+(i-1)*6+4) = gbuf%SIG(ii(4)+i)
117 wa(jj+(i-1)*6+5) = gbuf%SIG(ii(5)+i)
118 wa(jj+(i-1)*6+6) = gbuf%SIG(ii(6)+i)
119 ENDDO
120 jj = jj + 6*llt
121 ENDIF
122 ENDDO
123 ngf = ngl + 1
124 jj_loc(nn) = jj - compteur ! size of each group
125 compteur = jj
126 ENDDO
127! ++++++++++
128 IF( nspmd>1 ) THEN
129 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
130 ELSE
131 wap0_loc(1:jj) = wa(1:jj)
132 adress(1,1) = 1
133 DO nn = 2,nspgroup+1
134 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
135 ENDDO
136 ENDIF
137! ++++++++++
138 IF(ispmd==0) THEN
139 resp0 = 0
140 DO nn=1,nspgroup
141 compteur = 0
142 DO k = 1,nspmd
143 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
144 DO l = adress(nn,k),adress(nn+1,k)-1
145 compteur = compteur + 1
146 wap0(compteur+resp0) = wap0_loc(l)
147 ENDDO ! l=... , ...
148 ENDIF !if(size_loc>0)
149 ENDDO ! k=1,nspmd
150
151 jj_old = compteur+resp0
152 IF(jj_old > 0) THEN
153 res=mod(jj_old,6)
154 wrtlen=jj_old-res
155 IF (wrtlen > 0) THEN
156 IF (outyy_fmt == 2) THEN
157 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
158 ELSE
159 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
160 END IF
161 ENDIF
162 DO i=1,res
163 wap0(i)=wap0(wrtlen+i)
164 ENDDO
165 resp0=res
166 ENDIF ! jj_old>0
167 ENDDO ! nn=1,nspgroup
168 IF (resp0 > 0) THEN
169 IF (outyy_fmt == 2) THEN
170 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
171 ELSE
172 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
173 ENDIF
174 ENDIF
175 END IF ! ispmd = 0
176 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

◆ outp_sp_tt()

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

Definition at line 189 of file outp_sp_t.F.

191C-----------------------------------------------
192C M o d u l e s
193C-----------------------------------------------
194 USE initbuf_mod
195 USE elbufdef_mod
196C-----------------------------------------------
197C I m p l i c i t T y p e s
198C-----------------------------------------------
199#include "implicit_f.inc"
200C-----------------------------------------------
201C C o m m o n B l o c k s
202C-----------------------------------------------
203#include "vect01_c.inc"
204#include "scr16_c.inc"
205#include "com01_c.inc"
206#include "param_c.inc"
207#include "units_c.inc"
208#include "task_c.inc"
209#include "sphcom.inc"
210C-----------------------------------------------
211C D u m m y A r g u m e n t s
212C-----------------------------------------------
213 CHARACTER*10 KEY
214 CHARACTER*40 TEXT
215 INTEGER KXSP(NISP,*),IPARG(NPARG,*), DD_IAD(NSPMD+1,*),
216 . IPM(NPROPMI,*),SIZ_WR
217 INTEGER SIZLOC,SIZP0
218 my_real
219 . spbuf(nspbuf,*)
220 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
221C-----------------------------------------------
222C L o c a l V a r i a b l e s
223C-----------------------------------------------
224 INTEGER I,J,K,II(6),JJ, JJ_OLD,NPTR, NPTS, NPTT,NPTG,
225 . NG, NEL, IADD, N,NGF, NGL, NN, LEN,MLW,COMPTEUR,L
226 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
227 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
228 my_real
229 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
230 my_real
231 . func(6)
232 TYPE(G_BUFEL_) ,POINTER :: GBUF
233C=======================================================================
234 IF (ispmd == 0) THEN
235 WRITE(iugeo,'(2A)')'/SPHCEL /TENSOR /',key
236 WRITE(iugeo,'(A)')text
237 IF (outyy_fmt == 2) THEN
238 WRITE(iugeo,'(A)')
239 . '#FORMAT:(3E12.5),
240 . EINT(I),RHO(I),H(I),I=1,NUMSPH '
241 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/E12.5) ',
242 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),',
243 . '#EPSP(I),I=1,NUMSPH)'
244 ELSE
245 WRITE(iugeo,'(A)')
246 . '#FORMAT:(3E20.13),
247 . EINT(I),RHO(I),H(I),I=1,NUMSPH '
248 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/E20.13) ',
249 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),',
250 . '#EPSP(I),I=1,NUMSPH)'
251 END IF
252 END IF
253C
254 jj_old = 1
255 ngf = 1
256 ngl = 0
257 jj = 0
258 compteur = 0
259 DO nn=1,nspgroup
260 ngl = ngl + dd_iad(ispmd+1,nn)
261 DO ng = ngf, ngl
262 ity =iparg(5,ng)
263 IF (ity == 51) THEN
264 CALL initbuf(iparg ,ng ,
265 2 mtn ,nel ,nft ,iad ,ity ,
266 3 npt ,jale ,ismstr ,jeul ,jtur ,
267 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
268 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
269 6 irep ,iint ,igtyp ,israt ,isrot ,
270 7 icsen ,isorth ,isorthg ,ifailure,jsms )
271 gbuf => elbuf_tab(ng)%GBUF
272 lft=1
273 llt=nel
274!
275 DO i=1,6
276 ii(i) = nel*(i-1)
277 ENDDO
278!
279 DO i=lft,llt
280 wa(jj+1) = gbuf%EINT(i)
281 wa(jj+2) = gbuf%RHO(i)
282 wa(jj+3) = spbuf(1,nft+i)
283 wa(jj+4) = gbuf%SIG(ii(1)+i)
284 wa(jj+5) = gbuf%SIG(ii(2)+i)
285 wa(jj+6) = gbuf%SIG(ii(3)+i)
286 wa(jj+7) = gbuf%SIG(ii(4)+i)
287 wa(jj+8) = gbuf%SIG(ii(5)+i)
288 wa(jj+9) = gbuf%SIG(ii(6)+i)
289 IF (gbuf%G_PLA > 0) THEN
290 wa(jj+10) = gbuf%PLA(i)
291 wa(jj+11) = one
292 ELSE
293 wa(jj+10) = zero
294 wa(jj+11) = - one
295 ENDIF
296 jj=jj+11
297 ENDDO
298 ENDIF
299 ENDDO
300 ngf = ngl + 1
301 jj_loc(nn) = jj - compteur ! size of each group
302 compteur = jj
303 ENDDO ! nn=1,nspdgroup
304
305! ++++++++++
306 IF( nspmd>1 ) THEN
307 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
308 ELSE
309 wap0_loc(1:jj) = wa(1:jj)
310 adress(1,1) = 1
311 DO nn = 2,nspgroup+1
312 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
313 ENDDO
314 ENDIF
315! ++++++++++
316 IF(ispmd==0) THEN
317 DO nn=1,nspgroup
318 compteur = 0
319 DO k = 1,nspmd
320 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
321 DO l = adress(nn,k),adress(nn+1,k)-1
322 compteur = compteur + 1
323 wap0(compteur) = wap0_loc(l)
324 ENDDO ! l=... , ...
325 ENDIF !if(size_loc>0)
326 ENDDO ! k=1,nspmd
327
328 jj_old = compteur
329 IF(jj_old>0) THEN
330 IF (outyy_fmt == 2) THEN
331 j = 1
332 DO WHILE (j<jj_old)
333 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3) ! j-1+k=1,...,3
334 j=j+3 ! j = 4
335 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)! j-1+k = 4,...,9
336 IF (wap0(j+7) > zero) WRITE(iugeo,'(1P1E12.5)') (wap0(j+6)) ! test on G_PLA (wa(11)) then write wa(10)
337 j=j+8 ! j = 12
338 ENDDO
339 ELSE
340 j = 1
341 DO WHILE (j<=jj_old)
342 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3) ! j-1+k=1,...,3
343 j=j+3 ! j = 4
344 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6) ! j-1+k = 4,...,9
345 IF (wap0(j+7) > zero) WRITE(iugeo,'(1P1E20.13)') (wap0(j+6)) ! test on G_PLA (wa(11)) then write wa(10)
346 j=j+8 ! j = 12
347 ENDDO
348 END IF
349 END IF
350 ENDDO ! nn=1,nspgroup
351 END IF ! ispmd=0
352C-----------
353 RETURN