OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_c_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_c_s ../engine/source/output/sty/outp_c_s.F
25!||--- called by ------------------------------------------------------
26!|| genoutp ../engine/source/output/sty/genoutp.F
27!||--- calls -----------------------------------------------------
28!|| s_user ../engine/source/output/sty/s_user.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!|| element_mod ../common_source/modules/elements/element_mod.F90
33!||====================================================================
34 SUBROUTINE outp_c_s(NBXX,KEY,TEXT,ELBUF_TAB,IPARG ,EANI,
35 . IPM ,IGEO,IXC ,IXTG ,DD_IAD,SIZLOC,SIZP0,THKE,SIZ_WR)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 use element_mod , only : nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "units_c.inc"
52#include "task_c.inc"
53#include "scr16_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 CHARACTER*11 KEY
58 CHARACTER*40 TEXT
59 INTEGER NBXX,SIZLOC,SIZP0
60 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),DD_IAD(NSPMD+1,*) ,
61 . iparg(nparg,*),ipm(npropmi,*),igeo(npropgi,*),
62 . siz_wr
63 my_real
64 . eani(*),thke(*)
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,K,JJ,RESP0,WRTLEN,RES
70 INTEGER NG, NEL, NFT, ITY, LFT, NPT,NLAY,NPTR,NPTS,NPTT,
71 . llt, mlw, istrain,n,il,ir,is,it,
72 . ihbe, jj_old, ngf, ngl, nn, imx,nuvar,l,
73 . nbx,npg,mpt,ipt,i1,nu,kk,nvar,ithk,compteur,
74 . ij(3)
75 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
76 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
77 my_real
78 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
79
80 my_real
81 . fac,s1, s2, s12, vonm2,mean_gauss
82 my_real
83 . func(6)
84 TYPE(buf_lay_) ,POINTER :: BUFLY
85 TYPE(L_BUFEL_) ,POINTER :: LBUF
86 TYPE(g_bufel_) ,POINTER :: GBUF
87 TYPE(buf_mat_) ,POINTER :: MBUF
88 TYPE(l_bufel_) ,POINTER :: LBUF1,LBUF2,LBUF3,LBUF4
89C-----------------------------------------------
90 nbx = nbxx
91 IF (nbx < 0) THEN
92 nbx = -nbx
93 imx = 1
94 ELSE
95 imx = 0
96 ENDIF
97 IF (ispmd == 0) THEN
98 WRITE(iugeo,'(2A)')'/SHELL /SCALAR /',key
99 WRITE(iugeo,'(A)')text
100 IF(nbx == 26) THEN
101 IF (outyy_fmt == 2) THEN
102 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5)
103 . (((VAR(NU,IPT,I),NU=1,NUVAR),IPT=1,NPT),I=1,NUMSHL)'
104 ELSE
105 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13)
106 . (((VAR(NU,IPT,I),NU=1,NUVAR),IPT=1,NPT),I=1,NUMSHL)'
107 ENDIF
108 ELSEIF( nbx >= 27 .OR.nbx >= 86) THEN
109 IF (outyy_fmt == 2) THEN
110 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5)
111 . (((UVAR(IPT,I)),IPT=1,NPT),I=1,NUMSHL)'
112 ELSE
113 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13)
114 . (((UVAR(IPT,I)),IPT=1,NPT),I=1,NUMSHL)'
115 ENDIF
116 ELSE
117 IF (outyy_fmt == 2) THEN
118 WRITE(iugeo,'(A)')'#FORMAT: (1P6E12.5) (VAR(I),I=1,NUMSHL)'
119 ELSE
120 WRITE(iugeo,'(A)')'#FORMAT: (1P6E20.13) (VAR(I),I=1,NUMSHL)'
121 ENDIF
122 ENDIF
123 ENDIF
124C
125 jj_old = 1
126 resp0 = 1
127 ngf = 1
128 ngl = 0
129 jj = 0
130 compteur = 0
131 DO nn=1,nspgroup
132 ngl = ngl + dd_iad(ispmd+1,nn)
133 DO ng = ngf, ngl
134 ity =iparg(5,ng)
135 IF (ity == 3 .or. ity == 7) THEN
136 mlw =iparg(1,ng)
137 nel =iparg(2,ng)
138 nft =iparg(3,ng)
139 istrain=iparg(44,ng)
140 ihbe =iparg(23,ng)
141 ithk =iparg(28,ng)
142 nft =iparg(3,ng)
143 lft=1
144 llt=nel
145!
146 DO k=1,3
147 ij(k) = nel*(k-1)
148 ENDDO
149!
150 IF (mlw == 25.OR.mlw == 27.OR.mlw == 32) istrain=1
151 IF( (mlw/=0).AND.(mlw/=13) ) THEN
152 gbuf => elbuf_tab(ng)%GBUF
153 nlay = elbuf_tab(ng)%NLAY
154 nptr = elbuf_tab(ng)%NPTR
155 npts = elbuf_tab(ng)%NPTS
156 npg = nptr*npts
157 npt = iparg(6,ng)
158 mpt = max(1,npt)
159 ENDIF
160C
161 IF(((nbx>=20.AND.nbx<=24).OR.(nbx>=26.AND.nbx<=83)).AND.
162 . (mlw == 1.OR.mlw == 2.OR.mlw == 3.OR.mlw == 19.OR.
163 . mlw == 22.OR.mlw == 15.OR.mlw == 23.OR.mlw == 25.OR.
164 . mlw == 27.OR.mlw == 32)) THEN
165C Writing 0. If law not user and outp user requests
166 DO i=lft,llt
167 jj=jj+1
168 wa(jj) = zero
169 ENDDO
170C-----------
171 ELSEIF (nbx == 1) THEN
172 DO i=lft,llt
173 jj = jj + 1
174 IF( (mlw/=0).AND.(mlw/=13) ) THEN
175 s1 = gbuf%FOR(ij(1)+i)
176 s2 = gbuf%FOR(ij(2)+i)
177 s12= gbuf%FOR(ij(3)+i)
178 vonm2= s1*s1 + s2*s2 - s1*s2 + three*s12*s12
179 wa(jj) = sqrt(vonm2)
180 ELSE
181 wa(jj) = zero
182 ENDIF
183 ENDDO
184c-----------
185 ELSEIF (nbx == 3) THEN ! thickness
186 IF (ithk > 0) THEN
187 DO i=lft,llt
188 jj=jj+1
189 IF (mlw /= 0 .AND. mlw /= 13) THEN
190 wa(jj) = gbuf%THK(i)
191 ELSE
192 wa(jj) = zero
193 ENDIF
194 ENDDO
195 ELSE
196 DO i=lft,llt
197 jj=jj+1
198 n = i + nft
199 wa(jj) = thke(n)
200 ENDDO
201 ENDIF
202c-----------
203 ELSEIF (nbx == 5) THEN ! EINT
204 DO i=lft,llt
205 jj = jj + 1
206 IF (mlw /= 0 .AND. mlw /= 13) THEN
207 wa(jj) = gbuf%EINT(i) + gbuf%EINT(i+llt)
208 ELSE
209 wa(jj) = zero
210 ENDIF
211 ENDDO
212c-----------
213 ELSEIF (nbx == 6) THEN ! OFF
214 DO i=lft,llt
215 jj = jj + 1
216 IF( (mlw/=0).AND.(mlw/=13) ) THEN
217 wa(jj) = gbuf%OFF(i)
218 ELSE
219 wa(jj) = zero
220 ENDIF
221 ENDDO
222c-----------
223 ELSEIF (nbxx == 15) THEN ! plastic strain
224 DO i=lft,llt
225 jj = jj + 1
226 wa(jj) = zero
227 IF ( (mlw/=0).AND.(mlw/=13) ) THEN
228 IF (gbuf%G_PLA > 0) wa(jj) = gbuf%PLA(i)
229 ENDIF
230 ENDDO
231c-----------
232 ELSEIF (nbxx == -15) THEN ! max plastic strain
233 DO i=lft,llt
234 jj = jj + 1
235 wa(jj) = zero
236 IF (mlw /= 0 .AND. mlw /= 13) THEN
237 IF (gbuf%G_PLA > 0) THEN
238 DO il=1,nlay
239 bufly => elbuf_tab(ng)%BUFLY(il)
240 nptt = bufly%NPTT
241 IF (bufly%L_PLA > 0) THEN
242 DO is=1,npts
243 DO ir=1,nptr
244 DO it=1,nptt
245 lbuf => bufly%LBUF(ir,is,it)
246 wa(jj) = max(wa(jj),lbuf%PLA(i))
247 ENDDO
248 ENDDO
249 ENDDO
250 ENDIF
251 ENDDO
252 ENDIF
253 ENDIF
254 ENDDO ! DO I=LFT,LLT
255c-----------
256 ELSEIF (nbx == 25) THEN ! Hourglass
257 DO i=lft,llt
258 jj=jj+1
259 IF (ity == 7) THEN
260 wa(jj)=zero
261 ELSE
262 wa(jj)=eani(nft + i + numels)
263 ENDIF
264 ENDDO
265C-----------
266 ELSEIF (nbx>=20.AND.nbx<=24.AND.ihbe == 11) THEN
267 CALL s_user(nbx,imx,ihbe,nel,npt,mlw,ipm,igeo, ixc,
268 . ity ,jj,elbuf_tab(ng),wa, nft, func,
269 . nlay,nptr,npts)
270C-----------
271 ELSEIF (nbx == 26) THEN
272 IF ((mlw>=29.AND.mlw<=31).OR.mlw == 35.OR.
273 . mlw == 36.OR.mlw == 43.OR.mlw == 44.OR.
274 . mlw == 45.OR.mlw == 48.OR.mlw>=50) THEN
275 npg=0
276 IF (ihbe == 11) THEN ! BATOZ
277 IF (ity == 3) THEN
278 npg =4
279 fac = fourth
280 ELSEIF (ity == 7) THEN
281 npg =3
282 fac = third
283 ENDIF
284c
285 IF (nlay > 1) THEN
286cc IT = 1
287 DO i=1,nel
288 wa(jj + 1) = ihbe
289 wa(jj + 2) = npt
290 wa(jj + 3) = npg
291 wa(jj + 4) = nuvar
292 jj = jj + 4
293 DO il=1,nlay
294 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
295 DO ir=1,nptr
296 DO is=1,npts
297 DO it=1,nptt
298 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
299 nuvar = elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
300 DO nu= 1,nuvar
301 jj= jj + 1
302 i1 = (nu -1)*nel
303 wa(jj) = mbuf%VAR(i1 + i)
304 ENDDO
305 ENDDO
306 ENDDO
307 ENDDO
308 ENDDO
309 ENDDO ! I=1,NEL
310 ELSE ! NLAY = 1
311 il = 1
312 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
313 DO i=1,nel
314 wa(jj + 1) = ihbe
315 wa(jj + 2) = npt
316 wa(jj + 3) = npg
317 wa(jj + 4) = nuvar
318 jj = jj + 4
319 DO is=1,npts
320 DO ir=1,nptr
321 DO it=1,nptt
322 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
323 nuvar = elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
324 DO nu= 1,nuvar
325 jj= jj + 1
326 i1 = (nu-1)*nel
327 wa(jj) = mbuf%VAR(i1 + i)
328 ENDDO
329 ENDDO
330 ENDDO
331 ENDDO
332 ENDDO ! i=1,nel
333 ENDIF ! NLAY
334 ELSE ! not Batoz
335 DO i=lft,llt
336 wa(jj + 1) = ihbe
337 wa(jj + 2) = npt
338 wa(jj + 3) = npg
339 wa(jj + 4) = nuvar
340 jj = jj + 4
341 DO il=1,nlay
342 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
343 DO it=1,nptt
344 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(1,1,it)
345 nuvar = elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
346 DO nu=1,nuvar
347 jj = jj + 1
348 i1 = (nu-1)*nel
349 wa(jj)= mbuf%VAR(i1 + i)
350 ENDDO
351 ENDDO
352 ENDDO
353 ENDDO
354 ENDIF ! IHBE
355 ENDIF ! MLW
356c----------
357 ELSEIF(nbx >= 27 .AND. nbx <= 86 )THEN
358 IF ((mlw>=29.AND.mlw<=31).OR.
359 . mlw == 35.OR.mlw == 36.OR.mlw == 43.OR.
360 . mlw == 44.OR.mlw == 45.OR.mlw == 48.OR.mlw>=50) THEN
361 npg=0
362 nu = nbx - 26
363 i1 = (nu -1)*nel
364 IF (ihbe == 11) THEN ! BATOZ
365 IF (ity == 3) THEN
366 npg = 4
367 fac = fourth
368 ELSEIF(ity == 7)THEN
369 npg = 3
370 fac = third
371 ENDIF
372C
373 wa(jj + 1) = ihbe
374 wa(jj + 2) = npt
375 wa(jj + 3) = npg
376 wa(jj + 4) = nel
377 jj = jj + 4
378 IF (nlay > 1) THEN
379cc IT = 1
380 DO i=1,nel
381 DO il=1,nlay
382 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
383 DO is=1,npts
384 DO ir=1,nptr
385 DO it=1,nptt
386 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
387 jj= jj + 1
388 wa(jj) = mbuf%VAR(i1 + i)
389 ENDDO
390 ENDDO
391 ENDDO
392 ENDDO
393 ENDDO
394 ELSE ! NLAY = 1
395 il = 1
396 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
397 DO i=1,nel
398 DO is=1,npts
399 DO ir=1,nptr
400 DO it=1,nptt
401 nuvar = elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
402 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
403 jj= jj + 1
404 wa(jj) = mbuf%VAR(i1 + i)
405 ENDDO
406 ENDDO
407 ENDDO
408 ENDDO
409 ENDIF ! NLAY
410 ELSE ! not Batoz
411 wa(jj + 1) = ihbe
412 wa(jj + 2) = npt
413 wa(jj + 3) = npg
414 wa(jj + 4) = nel
415 jj = jj + 4
416 DO i=lft,llt
417 DO il=1,nlay
418 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
419 DO it=1,nptt
420 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(1,1,it)
421 jj = jj + 1
422 wa(jj)= mbuf%VAR(i1 + i)
423 ENDDO
424 ENDDO
425 ENDDO
426 ENDIF ! IHBE
427 ENDIF ! MLW
428c---------
429 ELSEIF (nbx == 87) THEN
430C equivalent stress - other then VON MISES
431 IF ( (mlw/=0).AND.(mlw/=13) ) THEN
432 IF (gbuf%G_SEQ > 0) THEN
433 IF (nlay > 1) THEN
434 il = iabs(nlay)/2 + 1
435 bufly => elbuf_tab(ng)%BUFLY(il)
436 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
437 IF (npg > 1) THEN
438 DO i=lft,llt
439 jj = jj + 1
440 DO it=1,nptt
441 lbuf1 => bufly%LBUF(1,1,it)
442 lbuf2 => bufly%LBUF(2,1,it)
443 lbuf3 => bufly%LBUF(1,2,it)
444 lbuf4 => bufly%LBUF(2,2,it)
445 mean_gauss = fourth*(lbuf1%SEQ(i) + lbuf2%SEQ(i) +
446 . lbuf3%SEQ(i) + lbuf4%SEQ(i))
447 wa(jj) = wa(jj) + mean_gauss/nptt
448cc WA(JJ) = FOURTH*(LBUF1%SEQ(I) + LBUF2%SEQ(I) +
449cc . LBUF3%SEQ(I) + LBUF4%SEQ(I))
450 ENDDO
451 ENDDO
452 ELSE
453 DO i=lft,llt
454 jj = jj + 1
455 DO it=1,nptt
456 wa(jj) = wa(jj) + bufly%LBUF(1,1,it)%SEQ(i)/nptt
457 ENDDO
458cc WA(JJ) = BUFLY%LBUF(1,1,1)%SEQ(I)
459 ENDDO
460 ENDIF
461 ELSEIF (npg > 1) THEN ! (NLAY = 1)
462 nptt = elbuf_tab(ng)%BUFLY(1)%NPTT
463 ipt = iabs(nptt)/2 + 1
464cc IPT = IABS(NPT)/2 + 1
465 bufly => elbuf_tab(ng)%BUFLY(1)
466 DO i=lft,llt
467 jj = jj + 1
468 lbuf1 => bufly%LBUF(1,1,ipt)
469 lbuf2 => bufly%LBUF(2,1,ipt)
470 lbuf3 => bufly%LBUF(1,2,ipt)
471 lbuf4 => bufly%LBUF(2,2,ipt)
472 wa(jj) = fourth*(lbuf1%SEQ(i) + lbuf2%SEQ(i) +
473 . lbuf3%SEQ(i) + lbuf4%SEQ(i))
474 ENDDO
475 ELSE ! (NLAY = 1 .and. NPG = 1)
476 nptt = elbuf_tab(ng)%BUFLY(1)%NPTT
477 ipt = iabs(nptt)/2 + 1
478cc IPT = IABS(NPT)/2 + 1
479 bufly => elbuf_tab(ng)%BUFLY(1)
480 DO i=lft,llt
481 jj = jj + 1
482 wa(jj) = bufly%LBUF(1,1,ipt)%SEQ(i)
483 ENDDO
484 ENDIF ! IF (NLAY > 1) THEN
485 ELSE ! VON MISES
486 DO i=lft,llt
487 jj = jj + 1
488 s1 = gbuf%FOR(ij(1)+i)
489 s2 = gbuf%FOR(ij(2)+i)
490 s12= gbuf%FOR(ij(3)+i)
491 vonm2 = s1*s1 + s2*s2 - s1*s2 + three*s12*s12
492 wa(jj) = sqrt(vonm2)
493 ENDDO
494 ENDIF ! IF (GBUF%G_SEQ > 0) THEN
495 ELSE ! MLW /=0 or 13
496 DO i=lft,llt
497 jj = jj + 1
498 wa(jj) = zero
499 ENDDO
500 ENDIF ! MLW /=0 or 13
501c---------
502 ELSE ! other not recognized NBX
503 DO i=lft,llt
504 jj = jj + 1
505 wa(jj) = zero
506 ENDDO
507 ENDIF ! NBX
508 ENDIF ! IF (ITY == 3 .or. ITY == 7) THEN
509 ENDDO ! DO NG = NGF, NGL
510c-----------------------------------------------------------------
511 ngf = ngl + 1
512 jj_loc(nn) = jj - compteur ! size of each group
513 compteur = jj
514 ENDDO
515! ++++++++++
516 IF( nspmd>1 ) THEN
517 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
518 ELSE
519 wap0_loc(1:jj) = wa(1:jj)
520 adress(1,1) = 1
521 DO nn = 2,nspgroup+1
522 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
523 ENDDO
524 ENDIF
525! ++++++++++
526 IF(ispmd==0) THEN
527 resp0 = 0
528 DO nn=1,nspgroup
529 compteur = 0
530 DO k = 1,nspmd
531 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
532 DO l = adress(nn,k),adress(nn+1,k)-1
533 compteur = compteur + 1
534 wap0(compteur+resp0) = wap0_loc(l)
535 ENDDO ! l=... , ...
536 ENDIF !if(size_loc>0)
537 ENDDO ! k=1,nspmd
538
539 jj_old = compteur+resp0
540c-----------------------------------------------------------------
541 IF (jj_old > 0) THEN
542c-------
543 IF (nbx == 26) THEN ! all User variables
544 j = 1
545 DO WHILE (j<jj_old+1)
546 ihbe = nint(wap0(j ))
547 npt = nint(wap0(j + 1))
548 npg = nint(wap0(j + 2))
549 nuvar = nint(wap0(j + 3))
550 j = j + 4
551 IF (outyy_fmt == 2) THEN
552 WRITE(iugeo,'(4I8)')ihbe,npt,npg,nuvar
553 ELSE
554 WRITE(iugeo,'(4I10)')ihbe,npt,npg,nuvar
555 ENDIF
556c
557 IF (npg == 0) THEN
558 IF (npt == 0) THEN
559 IF (outyy_fmt == 2) THEN
560 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k - 1),k=1,nuvar)
561 ELSE
562 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k - 1),k=1,nuvar)
563 ENDIF
564 j = j + nuvar
565 ELSE
566 DO ipt = 1,npt
567 IF (outyy_fmt == 2) THEN
568 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k - 1),k=1,nuvar)
569 ELSE
570 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k - 1),k=1,nuvar)
571 ENDIF
572 j = j + nuvar
573 ENDDO
574 ENDIF
575 ELSE ! IF (NPG == 0)
576 IF (npt == 0) THEN
577 DO kk = 1,npg
578 IF (outyy_fmt == 2) THEN
579 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k - 1),k=1,nuvar)
580 ELSE
581 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k - 1),k=1,nuvar)
582 ENDIF
583 j = j + nuvar
584 ENDDO
585 ELSE
586 DO kk = 1,npg
587 DO ipt = 1,npt
588 IF(outyy_fmt == 2) THEN
589 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k - 1),k=1,nuvar)
590 ELSE
591 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k - 1),k=1,nuvar)
592 ENDIF
593 j = j + nuvar
594 ENDDO
595 ENDDO
596 ENDIF
597 ENDIF
598 ENDDO ! DO WHILE (J<JJ_OLD)
599c-------
600 ELSEIF (nbx >= 27 .AND. nbx <= 86) THEN ! single User variables
601 j = 1
602 DO WHILE (j<jj_old+1)
603 ihbe = nint(wap0(j ))
604 npt = nint(wap0(j + 1))
605 npg = nint(wap0(j + 2))
606 nel = nint(wap0(j + 3))
607 nvar = nel*max(1,npt)*max(1,npg)
608 j = j + 4
609 WRITE(iugeo,'(A)')'#FORMAT:IHBE,NPT,NPG'
610 IF (outyy_fmt == 2) THEN
611 WRITE(iugeo,'(3I8)')ihbe,npt,npg
612 ELSE
613 WRITE(iugeo,'(3I10)')ihbe,npt,npg
614 ENDIF
615 IF (outyy_fmt == 2) THEN
616 WRITE(iugeo,'(1P6E12.5)')(wap0(j + k - 1),k=1,nvar)
617 ELSE
618 WRITE(iugeo,'(1P6E20.13)')(wap0(j + k - 1),k=1,nvar)
619 ENDIF
620 j = j + nvar
621 ENDDO ! DO WHILE (J<JJ_OLD)
622c-------
623 ELSE ! Other NBX
624 res=mod(jj_old,6)
625 wrtlen=jj_old-res
626 IF (wrtlen > 0) THEN
627 IF (outyy_fmt == 2) THEN
628 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
629 ELSE
630 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
631 ENDIF
632 ENDIF
633 DO i=1,res
634 wap0(i)=wap0(wrtlen+i)
635 ENDDO
636 resp0=res
637 ENDIF ! NBX
638c
639 ENDIF ! IF (JJ_OLD > 0) THEN
640c-------
641 ENDDO ! DO NN=1,NSPGROUP
642c---
643 IF (resp0>0) THEN
644 IF (outyy_fmt == 2) THEN
645 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
646 ELSE
647 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
648 ENDIF
649 ENDIF
650c---
651 ENDIF ! ispmd = 0
652c-----------
653 RETURN
654 END
655c
656!||====================================================================
657!|| count_arsz_cs ../engine/source/output/sty/outp_c_s.F
658!||--- called by ------------------------------------------------------
659!|| genoutp ../engine/source/output/sty/genoutp.F
660!|| outp_arsz_cs ../engine/source/mpi/interfaces/spmd_outp.F
661!||--- uses -----------------------------------------------------
662!|| element_mod ../common_source/modules/elements/element_mod.F90
663!||====================================================================
664 SUBROUTINE count_arsz_cs(IPARG,IXC,IXTG,IGEO,IPM,DD_IAD,WASZ,SIZ_WRITE_LOC)
665 use element_mod , only : nixc,nixtg
666C-----------------------------------------------
667C I m p l i c i t T y p e s
668C-----------------------------------------------
669#include "implicit_f.inc"
670C-----------------------------------------------
671C C o m m o n B l o c k s
672C-----------------------------------------------
673#include "com01_c.inc"
674#include "scr16_c.inc"
675#include "param_c.inc"
676#include "task_c.inc"
677C-----------------------------------------------
678C D u m m y A r g u m e n t s
679C-----------------------------------------------
680 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),DD_IAD(NSPMD+1,*) ,
681 . iparg(nparg,*),ipm(npropmi,*),wasz(2),igeo(npropgi,*),
682 , iuser_full,siz_write_loc(2*nspgroup+2)
683
684C-----------------------------------------------
685C L o c a l V a r i a b l e s
686C-----------------------------------------------
687 INTEGER JJ,NGF,NGL,NN,ITY,NFT,LFT,LLT,NPT,
688 . ihbe,igtyp,nuvar,mlw,ng,nel,i,npg,mpt,
689 . wasz1,wasz26,j
690C-----------------------------------------------
691 wasz1 = 0
692 siz_write_loc = 0
693
694 IF ( outp_cs( 1) == 1.OR.outp_cs( 2) == 1.OR.outp_cs( 3) == 1
695 . .OR.outp_cs( 4) == 1.OR.outp_cs( 7) == 1.OR.outp_cs(25) == 1
696 . .OR.outp_cs(20) == 1.OR.outp_cs(21) == 1.OR.outp_cs(22) == 1
697 . .OR.outp_cs(23) == 1.OR.outp_cs(24) == 1) THEN
698
699 ngf = 1
700 ngl = 0
701
702 DO nn=1,nspgroup
703 jj = 0
704 ngl = ngl + dd_iad(ispmd+1,nn)
705 DO ng = ngf, ngl
706 ity =iparg(5,ng)
707 nel =iparg(2,ng)
708 IF(ity == 3.OR.ity == 7) THEN
709 jj = jj+nel
710 ENDIF
711 ENDDO
712 wasz1 = wasz1+jj
713 ngf = ngl + 1
714 siz_write_loc(nn) = jj
715 ENDDO
716 ENDIF
717 wasz26 = 0
718
719 IF (outp_cs(26) == 1) THEN
720
721 ngf = 1
722 ngl = 0
723 DO nn=1,nspgroup
724 jj = 0
725 ngl = ngl + dd_iad(ispmd+1,nn)
726 DO ng = ngf, ngl
727 ity =iparg(5,ng)
728 IF(ity == 3.OR.ity == 7) THEN
729 mlw =iparg(1,ng)
730 nel =iparg(2,ng)
731 nft =iparg(3,ng)
732 lft=1
733 llt=nel
734 npt =iparg(6,ng)
735 ihbe =iparg(23,ng)
736 nuvar = 0
737 IF(ity == 3)THEN
738 igtyp=igeo(11,ixc(nixc-1,1+nft))
739 DO i=lft,llt
740 nuvar = max(nuvar,ipm(8,ixc(1,i+nft)))
741 ENDDO
742 ELSE
743 igtyp=igeo(11,ixtg(nixtg-1,1+nft))
744 DO i=lft,llt
745 nuvar = max(nuvar,ipm(8,ixtg(1,i+nft)))
746 ENDDO
747 ENDIF
748
749 IF ((mlw>=29.AND.mlw<=31).OR.
750 . mlw == 35.OR.mlw == 36.OR.mlw == 43.OR.
751 . mlw == 44.OR.mlw == 45.OR.mlw == 48.OR.mlw>=50) THEN
752
753 npg=0
754
755 IF(ihbe == 11) THEN
756 IF (ity == 3) THEN
757 npg = 4
758 ELSEIF(ity == 7)THEN
759 npg =3
760 ENDIF
761 mpt=iabs(npt)
762 IF (mpt == 0) THEN
763 jj = jj + nel*(4+npg*nuvar)
764 ELSE
765 jj = jj + nel*(4+npg*mpt*nuvar)
766 END IF
767 ELSE
768 mpt=iabs(npt)
769 IF (mpt == 0) THEN
770 jj = jj + nel*(4+nuvar)
771 ELSE
772 jj = jj + nel*(4+mpt*nuvar)
773 END IF
774 END IF
775 END IF
776 END IF
777 END DO
778 wasz26 = wasz26+jj
779 ngf = ngl + 1
780 siz_write_loc(nspgroup+nn) = jj
781 END DO
782 ENDIF
783
784 iuser_full = 0
785 DO j=1,60
786 IF(outp_cs(26 + j) == 1) iuser_full = 1
787 ENDDO
788 IF ( iuser_full == 1 ) THEN
789 ngf = 1
790 ngl = 0
791C
792 DO nn=1,nspgroup
793 jj = 0
794 ngl = ngl + dd_iad(ispmd+1,nn)
795 DO ng = ngf, ngl
796 ity =iparg(5,ng)
797 IF(ity == 3.OR.ity == 7) THEN
798 mlw =iparg(1,ng)
799 nel =iparg(2,ng)
800 nft =iparg(3,ng)
801 lft=1
802 llt=nel
803 npt =iparg(6,ng)
804 ihbe =iparg(23,ng)
805 nuvar = 0
806 IF(ity == 3)THEN
807 igtyp=igeo(11,ixc(nixc-1,1+nft))
808 DO i=lft,llt
809 nuvar = max(nuvar,ipm(8,ixc(1,i+nft)))
810 ENDDO
811 ELSE
812 igtyp=igeo(11,ixtg(nixtg-1,1+nft))
813 DO i=lft,llt
814 nuvar = max(nuvar,ipm(8,ixtg(1,i+nft)))
815 ENDDO
816 ENDIF
817 IF ((mlw>=29.AND.mlw<=31).OR.
818 . mlw == 35.OR.mlw == 36.OR.mlw == 43.OR.
819 . mlw == 44.OR.mlw == 45.OR.mlw == 48.OR.mlw>=50) THEN
820
821 npg=0
822
823 IF(ihbe == 11) THEN
824 IF (ity == 3) THEN
825 npg = 4
826 ELSEIF(ity == 7)THEN
827 npg =3
828 ENDIF
829 mpt=iabs(npt)
830 IF (mpt == 0) THEN
831 jj = jj + 4 + nel*(npg)
832 ELSE
833 jj = jj + 4 + nel*(npg*mpt)
834 END IF
835 ELSE
836 mpt=iabs(npt)
837 IF (mpt == 0) THEN
838 jj = jj + 4 + nel
839 ELSE
840 jj = jj + 4 + nel*(mpt)
841 END IF
842 END IF
843 END IF
844 END IF
845 END DO
846 wasz26 = wasz26+jj
847 ngf = ngl + 1
848 siz_write_loc(nspgroup+nn) = siz_write_loc(nspgroup+nn) + jj
849 END DO
850 ENDIF
851 wasz(1) = wasz1
852 wasz(2) = wasz26
853 siz_write_loc(2*nspgroup+1) = wasz(1)
854 siz_write_loc(2*nspgroup+2) = wasz(2)
855
856
857 RETURN
858 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
nvar
integer function nvar(text)
Definition nvar.F:32
outp_c_s
subroutine outp_c_s(nbxx, key, text, elbuf_tab, iparg, eani, ipm, igeo, ixc, ixtg, dd_iad, sizloc, sizp0, thke, siz_wr)
Definition outp_c_s.F:36
count_arsz_cs
subroutine count_arsz_cs(iparg, ixc, ixtg, igeo, ipm, dd_iad, wasz, siz_write_loc)
Definition outp_c_s.F:665
s_user
subroutine s_user(nbx, imx, ihbe, nel, npt, mlw, ipm, igeo, ixc, ity, jj, elbuf_tab, wa, nft, func, nlay, nptr, npts)
Definition s_user.F:34
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1181