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