OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_s_t.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_t ../engine/source/output/sty/outp_s_t.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_t(NBX ,KEY,TEXT,ELBUF_TAB,IPARG,
35 . DD_IAD,SIZLOC,SIZP0,SIZ_WR)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE initbuf_mod
40 USE elbufdef_mod
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 "vect01_c.inc"
49#include "com01_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*10 KEY
58 CHARACTER*40 TEXT
59 INTEGER NBX,SIZLOC,SIZP0,SIZ_WR
60 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*)
61 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,J,NBB(20),RESP0,WRTLEN,RES
66 INTEGER NG, NEL, IADD, N,ISOLNOD,MLW,
67 . ii,jj,jj_old, ngf, ngl, nn, len,fwap0,lenwap0,
68 . compteur,l,k,kk(6)
69 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
70 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
71 my_real
72 . func(6)
73 my_real
74 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
75 TYPE(g_bufel_) ,POINTER :: GBUF
76C=======================================================================
77 IF (ispmd == 0) THEN
78 WRITE(iugeo,'(2A)')'/SOLID /TENSOR /',key
79 WRITE(iugeo,'(A)')text
80 IF (outyy_fmt == 2) THEN
81 WRITE(iugeo,'(2A)') '#FORMAT: (1P6E12.5) ',
82 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),I=1,NUMSOL)'
83 ELSE
84 WRITE(iugeo,'(2A)') '#FORMAT: (1P6E20.13) ',
85 . '(TX(I),TY(I),TZ(I),TXY(I),TYZ(I),TZX(I),I=1,NUMSOL)'
86 ENDIF
87 ENDIF
88C
89 ngf = 1
90 ngl = 0
91 jj = 0
92 compteur = 0
93 DO nn=1,nspgroup
94 ngl = ngl + dd_iad(ispmd+1,nn)
95 DO ng = ngf, ngl
96 ity = iparg(5,ng)
97 IF (ity == 1 .OR. ity == 2) THEN
98 CALL initbuf(iparg ,ng ,
99 2 mtn ,nel ,nft ,iad ,ity ,
100 3 npt ,jale ,ismstr ,jeul ,jtur ,
101 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
102 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
103 6 irep ,iint ,igtyp ,israt ,isrot ,
104 7 icsen ,isorth ,isorthg ,ifailure,jsms )
105 gbuf => elbuf_tab(ng)%GBUF
106 lft=1
107 llt=nel
108!
109 DO i=1,6
110 kk(i) = nel*(i-1)
111 ENDDO
112!
113 DO i=lft,llt
114 ii = (i-1)*6
115 wa(jj + ii + 1) = gbuf%SIG(kk(1)+i)
116 wa(jj + ii + 2) = gbuf%SIG(kk(2)+i)
117 wa(jj + ii + 3) = gbuf%SIG(kk(3)+i)
118 wa(jj + ii + 4) = gbuf%SIG(kk(4)+i)
119 wa(jj + ii + 5) = gbuf%SIG(kk(5)+i)
120 wa(jj + ii + 6) = gbuf%SIG(kk(6)+i)
121 ENDDO
122 jj = jj + 6*llt
123 ENDIF
124 ENDDO
125 ngf = ngl + 1
126 jj_loc(nn) = jj - compteur ! size of each group
127 compteur = jj
128 ENDDO ! do nn=1,nspgroup
129! ++++++++++
130 IF( nspmd>1 ) THEN
131 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
132 ELSE
133 wap0_loc(1:jj) = wa(1:jj)
134 adress(1,1) = 1
135 DO nn = 2,nspgroup+1
136 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
137 ENDDO
138 ENDIF
139! ++++++++++
140 IF(ispmd==0) THEN
141 resp0 = 0
142 jj_old = 0
143 DO nn=1,nspgroup
144 compteur = 0
145 DO k = 1,nspmd
146 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
147 DO l = adress(nn,k),adress(nn+1,k)-1
148 compteur = compteur + 1
149 wap0(compteur+resp0) = wap0_loc(l)
150 ENDDO ! l=... , ...
151 ENDIF !if(size_loc>0)
152 ENDDO ! k=1,nspmd
153
154 jj_old = compteur+resp0
155 IF (jj_old>0) THEN
156 res=mod(jj_old,6)
157 wrtlen=jj_old-res
158 IF (wrtlen>0) THEN
159 IF (outyy_fmt == 2) THEN
160 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,wrtlen)
161 ELSE
162 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,wrtlen)
163 ENDIF
164 ENDIF
165 DO i=1,res
166 wap0(i)=wap0(wrtlen+i)
167 ENDDO
168 resp0=res
169 ENDIF ! if(jj_old>0)
170 ENDDO ! do nn=1,nspgroup
171 IF ( resp0>0 ) THEN
172 IF (outyy_fmt == 2) THEN
173 WRITE(iugeo,'(1P6E12.5)')(wap0(j),j=1,resp0)
174 ELSE
175 WRITE(iugeo,'(1P6E20.13)')(wap0(j),j=1,resp0)
176 ENDIF
177 ENDIF
178 ENDIF
179c-----------
180 RETURN
181 END
182
183!||====================================================================
184!|| outp_s_tt ../engine/source/output/sty/outp_s_t.f
185!||--- called by ------------------------------------------------------
186!|| genoutp ../engine/source/output/sty/genoutp.F
187!||--- calls -----------------------------------------------------
188!|| initbuf ../engine/share/resol/initbuf.F
189!|| spmd_rgather9_1comm ../engine/source/mpi/interfaces/spmd_outp.F
190!||--- uses -----------------------------------------------------
191!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
192!|| initbuf_mod ../engine/share/resol/initbuf.F
193!||====================================================================
194 SUBROUTINE outp_s_tt(NBX ,KEY ,TEXT,ELBUF_TAB,IPARG,
195 2 DD_IAD ,IPM ,IXS,SIZLOC,SIZP0,SIZ_WR )
196C-----------------------------------------------
197C M o d u l e s
198C-----------------------------------------------
199 USE initbuf_mod
200 USE elbufdef_mod
201C-----------------------------------------------
202C I m p l i c i t T y p e s
203C-----------------------------------------------
204#include "implicit_f.inc"
205C-----------------------------------------------
206C C o m m o n B l o c k s
207C-----------------------------------------------
208#include "vect01_c.inc"
209#include "com01_c.inc"
210#include "param_c.inc"
211#include "units_c.inc"
212#include "task_c.inc"
213#include "scr16_c.inc"
214C-----------------------------------------------
215C D u m m y A r g u m e n t s
216C-----------------------------------------------
217 CHARACTER*10 KEY
218 CHARACTER*40 TEXT
219 INTEGER IXS(NIXS,*),IPM(NPROPMI,*),IPARG(NPARG,*),
220 . dd_iad(nspmd+1,*)
221 INTEGER NBX,SIZLOC,SIZP0,SIZ_WR
222 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
223C-----------------------------------------------
224C L o c a l V a r i a b l e s
225C-----------------------------------------------
226 INTEGER I,J,K,N,II,JJ,NLAY,NPTR,NPTS,NPTT,IL,IR,IS,IT,IPT,
227 . NG, NEL, IADD, MLW,JJ_OLD, NGF, NGL, NN, LEN, ICAS_OLD,
228 . isolnod,khbe,itens,tshell,compteur,l,kk(6)
229 my_real
230 . func(6)
231 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
232 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
233 my_real
234 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
235 TYPE(g_bufel_) ,POINTER :: GBUF
236 TYPE(L_BUFEL_) ,POINTER :: LBUF
237C=======================================================================
238 itens = nbx
239c-----------------------
240 IF (ispmd == 0) THEN
241 WRITE(iugeo,'(2A)')'/SOLID /TENSOR /',key
242 WRITE(iugeo,'(A)')text
243 ENDIF
244C
245 jj_old = 1
246 ngf = 1
247 ngl = 0
248 jj = 0
249 compteur = 0
250 DO nn=1,nspgroup
251 ngl = ngl + dd_iad(ispmd+1,nn)
252 DO ng = ngf, ngl
253 ity =iparg(5,ng)
254 IF (ity == 1.OR.ity == 2) THEN
255 CALL initbuf(iparg ,ng ,
256 2 mlw ,nel ,nft ,iad ,ity ,
257 3 npt ,jale ,ismstr ,jeul ,jtur ,
258 4 jthe ,jlag ,jmult ,khbe ,jivf ,
259 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
260 6 irep ,iint ,igtyp ,israt ,isrot ,
261 7 icsen ,isorth ,isorthg ,ifailure,jsms )
262 gbuf => elbuf_tab(ng)%GBUF
263 nlay = elbuf_tab(ng)%NLAY
264 nptr = elbuf_tab(ng)%NPTR
265 npts = elbuf_tab(ng)%NPTS
266 nptt = elbuf_tab(ng)%NPTT
267 npt = nptr * npts * nptt * nlay
268 lft=1
269 llt=nel
270 isolnod=iparg(28,ng)
271 tshell = 0
272 IF (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22) tshell = 1
273!
274 DO i=1,6
275 kk(i) = nel*(i-1)
276 ENDDO
277!
278C--------------------------------------
279 IF (itens == 2)THEN
280C /outp/brick/stress/full
281C------------------------------------
282 IF (tshell == 1) THEN
283 IF (khbe == 14 .OR. khbe == 16) THEN
284 DO i=lft,llt
285 wa(jj+1) = nlay
286 wa(jj+2) = nptr
287 wa(jj+3) = npts
288 wa(jj+4) = nptt
289 wa(jj+5) = abs(isolnod)
290 wa(jj+6) = iabs(khbe)
291 jj = jj + 6
292 DO ir=1,nptr
293 DO is=1,npts
294 DO it=1,nptt
295 DO il=1,nlay
296 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
297 wa(jj + 1) = lbuf%SIG(kk(1)+i)
298 wa(jj + 2) = lbuf%SIG(kk(2)+i)
299 wa(jj + 3) = lbuf%SIG(kk(3)+i)
300 wa(jj + 4) = lbuf%SIG(kk(4)+i)
301 wa(jj + 5) = lbuf%SIG(kk(5)+i)
302 wa(jj + 6) = lbuf%SIG(kk(6)+i)
303 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
304 wa(jj + 7) = zero
305 ELSE
306 wa(jj + 7) = lbuf%PLA(i)
307 ENDIF
308 wa(jj+8) = lbuf%EINT(i)
309 wa(jj+9) = lbuf%RHO(i)
310 jj = jj + 9
311 ENDDO ! IT=1,NPTT
312 ENDDO ! IS=1,NPTS
313 ENDDO ! IR=1,NPTR
314 ENDDO ! IL=1,NLAY
315 ENDDO ! I=LFT,LLT
316 ELSEIF (khbe == 15) THEN
317 DO i=lft,llt
318 wa(jj+1) = nlay
319 wa(jj+2) = nptr
320 wa(jj+3) = npts
321 wa(jj+4) = nptt
322 wa(jj+5) = abs(isolnod)
323 wa(jj+6) = iabs(khbe)
324 jj = jj + 6
325 DO il=1,nlay
326 DO ir=1,nptr
327 DO is=1,npts
328 DO it=1,nptt
329 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
330 wa(jj + 1) = lbuf%SIG(kk(1)+i)
331 wa(jj + 2) = lbuf%SIG(kk(2)+i)
332 wa(jj + 3) = lbuf%SIG(kk(3)+i)
333 wa(jj + 4) = lbuf%SIG(kk(4)+i)
334 wa(jj + 5) = lbuf%SIG(kk(5)+i)
335 wa(jj + 6) = lbuf%SIG(kk(6)+i)
336 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
337 wa(jj + 7) = zero
338 ELSE
339 wa(jj + 7) = lbuf%PLA(i)
340 ENDIF
341 wa(jj+8) = lbuf%EINT(i)
342 wa(jj+9) = lbuf%RHO(i)
343 jj = jj + 9
344 ENDDO ! IT=1,NPTT
345 ENDDO ! IS=1,NPTS
346 ENDDO ! IR=1,NPTR
347 ENDDO ! IL=1,NLAY
348 ENDDO ! I=LFT,LLT
349 ENDIF
350 ELSEIF (khbe == 14 .OR. khbe == 17 .OR. isolnod == 20 .OR.
351 . isolnod == 16) THEN
352 DO i=lft,llt
353 wa(jj+1) = nlay
354 wa(jj+2) = nptr
355 wa(jj+3) = npts
356 wa(jj+4) = nptt
357 wa(jj+5) = abs(isolnod)
358 wa(jj+6) = iabs(khbe)
359 jj = jj + 6
360 DO il=1,nlay
361 DO it=1,nptt
362 DO is=1,npts
363 DO ir=1,nptr
364 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
365 wa(jj + 1) = lbuf%SIG(kk(1)+i)
366 wa(jj + 2) = lbuf%SIG(kk(2)+i)
367 wa(jj + 3) = lbuf%SIG(kk(3)+i)
368 wa(jj + 4) = lbuf%SIG(kk(4)+i)
369 wa(jj + 5) = lbuf%SIG(kk(5)+i)
370 wa(jj + 6) = lbuf%SIG(kk(6)+i)
371 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
372 wa(jj + 7) = zero
373 ELSE
374 wa(jj + 7) = lbuf%PLA(i)
375 ENDIF
376 wa(jj+8) = lbuf%EINT(i)
377 wa(jj+9) = lbuf%RHO(i)
378 jj = jj + 9
379 ENDDO ! IT=1,NPTT
380 ENDDO ! IS=1,NPTS
381 ENDDO ! IR=1,NPTR
382 ENDDO ! IL=1,NLAY
383 ENDDO ! I=LFT,LLT
384c
385 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
386 . khbe /= 14 .AND. khbe /= 15 ) THEN
387 DO i=lft,llt
388 wa(jj+1) = nlay
389 wa(jj+2) = nptr
390 wa(jj+3) = npts
391 wa(jj+4) = nptt
392 wa(jj+5) = abs(isolnod)
393 wa(jj+6) = iabs(khbe)
394 wa(jj+7) = gbuf%EINT(i)
395 wa(jj+8) = gbuf%RHO(i)
396 jj = jj + 8
397 DO il=1,nlay
398 DO ir=1,nptr
399 DO is=1,npts
400 DO it=1,nptt
401 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
402 wa(jj + 1) = lbuf%SIG(kk(1)+i)
403 wa(jj + 2) = lbuf%SIG(kk(2)+i)
404 wa(jj + 3) = lbuf%SIG(kk(3)+i)
405 wa(jj + 4) = lbuf%SIG(kk(4)+i)
406 wa(jj + 5) = lbuf%SIG(kk(5)+i)
407 wa(jj + 6) = lbuf%SIG(kk(6)+i)
408 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
409 wa(jj + 7) = zero
410 ELSE
411 wa(jj + 7) = lbuf%PLA(i)
412 ENDIF
413 jj = jj + 7
414 ENDDO ! IT=1,NPTT
415 ENDDO ! IS=1,NPTS
416 ENDDO ! IR=1,NPTR
417 ENDDO ! IL=1,NLAY
418 ENDDO ! I=LFT,LLT
419c
420 ELSEIF (isolnod == 10) THEN
421 DO i=lft,llt
422 wa(jj+1) = nlay
423 wa(jj+2) = nptr
424 wa(jj+3) = npts
425 wa(jj+4) = nptt
426 wa(jj+5) = abs(isolnod)
427 wa(jj+6) = iabs(khbe)
428 jj = jj + 6
429 DO il=1,nlay
430 DO ir=1,nptr
431 DO is=1,npts
432 DO it=1,nptt
433 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
434 wa(jj + 1) = lbuf%SIG(kk(1)+i)
435 wa(jj + 2) = lbuf%SIG(kk(2)+i)
436 wa(jj + 3) = lbuf%SIG(kk(3)+i)
437 wa(jj + 4) = lbuf%SIG(kk(4)+i)
438 wa(jj + 5) = lbuf%SIG(kk(5)+i)
439 wa(jj + 6) = lbuf%SIG(kk(6)+i)
440 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
441 wa(jj + 7) = zero
442 ELSE
443 wa(jj + 7) = lbuf%PLA(i)
444 ENDIF
445 wa(jj+8) = lbuf%EINT(i)
446 wa(jj+9) = lbuf%RHO(i)
447 jj = jj + 9
448 ENDDO ! IT=1,NPTT
449 ENDDO ! IS=1,NPTS
450 ENDDO ! IR=1,NPTR
451 ENDDO ! IL=1,NLAY
452 ENDDO ! I=LFT,LLT
453c
454 ELSEIF ((isolnod == 6.OR.isolnod == 8).AND.
455 . khbe == 15) THEN
456 DO i=lft,llt
457 wa(jj+1) = nlay
458 wa(jj+2) = nptr
459 wa(jj+3) = npts
460 wa(jj+4) = nptt
461 wa(jj+5) = abs(isolnod)
462 wa(jj+6) = iabs(khbe)
463 jj = jj + 6
464 DO il=1,nlay
465 DO ir=1,nptr
466 DO is=1,npts
467 DO it=1,nptt
468 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
469 wa(jj + 1) = lbuf%SIG(kk(1)+i)
470 wa(jj + 2) = lbuf%SIG(kk(2)+i)
471 wa(jj + 3) = lbuf%SIG(kk(3)+i)
472 wa(jj + 4) = lbuf%SIG(kk(4)+i)
473 wa(jj + 5) = lbuf%SIG(kk(5)+i)
474 wa(jj + 6) = lbuf%SIG(kk(6)+i)
475 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
476 wa(jj + 7) = zero
477 ELSE
478 wa(jj + 7) = lbuf%PLA(i)
479 ENDIF
480 wa(jj+8) = lbuf%EINT(i)
481 wa(jj+9) = lbuf%RHO(i)
482 jj = jj + 9
483 ENDDO ! IT=1,NPTT
484 ENDDO ! IS=1,NPTS
485 ENDDO ! IR=1,NPTR
486 ENDDO ! IL=1,NLAY
487 ENDDO ! I=LFT,LLT
488c-------------
489 ELSE ! one integration pt, Isolid = 0,1,2,24
490c-------------
491 DO i=lft,llt
492 wa(jj+1) = nlay
493 wa(jj+2) = nptr
494 wa(jj+3) = npts
495 wa(jj+4) = nptt
496 wa(jj+5) = abs(isolnod)
497 wa(jj+6) = iabs(khbe)
498 wa(jj+7) = gbuf%EINT(i)
499 wa(jj+8) = gbuf%RHO(i)
500 jj = jj + 8
501 wa(jj + 1) = gbuf%SIG(kk(1)+i)
502 wa(jj + 2) = gbuf%SIG(kk(2)+i)
503 wa(jj + 3) = gbuf%SIG(kk(3)+i)
504 wa(jj + 4) = gbuf%SIG(kk(4)+i)
505 wa(jj + 5) = gbuf%SIG(kk(5)+i)
506 wa(jj + 6) = gbuf%SIG(kk(6)+i)
507 IF (gbuf%G_PLA == 0) THEN
508 wa(jj + 7) = zero
509 ELSE
510 wa(jj + 7) = gbuf%PLA(i)
511 ENDIF
512 jj = jj + 7
513 ENDDO ! I=LFT,LLT
514 ENDIF
515C--------------------------------------
516 ELSEIF (itens == 3)THEN
517c /outp/brick/strain/full
518C--------------------------------------
519 wa(jj+1) = npt
520 wa(jj+2) = isolnod
521 wa(jj+3) = nel
522 jj = jj+3
523 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA == 0) THEN
524 DO i=lft,llt
525 wa(jj + 1) = zero
526 wa(jj + 2) = zero
527 wa(jj + 3) = zero
528 wa(jj + 4) = zero
529 wa(jj + 5) = zero
530 wa(jj + 6) = zero
531 jj=jj + 6
532 ENDDO ! I=LFT,LLT
533 ELSEIF (mlw == 14) THEN
534 DO i=lft,llt
535 DO il=1,nlay
536 DO ir=1,nptr
537 DO is=1,npts
538 DO it=1,nptt
539 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
540 wa(jj + 1) = lbuf%EPE(kk(1)+i)
541 wa(jj + 2) = lbuf%EPE(kk(2)+i)
542 wa(jj + 3) = lbuf%EPE(kk(3)+i)
543 wa(jj + 4) = zero
544 wa(jj + 5) = zero
545 wa(jj + 6) = zero
546 jj=jj + 6
547 ENDDO
548 ENDDO
549 ENDDO
550 ENDDO
551 ENDDO
552 ELSEIF (tshell == 1) THEN
553 DO i=lft,llt
554 DO ir=1,nptr
555 DO is=1,npts
556 DO it=1,nptt
557 DO il=1,nlay
558 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
559 wa(jj + 1) = lbuf%STRA(kk(1)+i)
560 wa(jj + 2) = lbuf%STRA(kk(2)+i)
561 wa(jj + 3) = lbuf%STRA(kk(3)+i)
562 wa(jj + 4) = lbuf%STRA(kk(4)+i)
563 wa(jj + 5) = lbuf%STRA(kk(5)+i)
564 wa(jj + 6) = lbuf%STRA(kk(6)+i)
565 jj=jj + 6
566 ENDDO
567 ENDDO
568 ENDDO
569 ENDDO
570 ENDDO ! I=LFT,LLT
571 ELSE
572 DO i=lft,llt
573 DO il=1,nlay
574 DO it=1,nptt
575 DO is=1,npts
576 DO ir=1,nptr
577 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
578 wa(jj + 1) = lbuf%STRA(kk(1)+i)
579 wa(jj + 2) = lbuf%STRA(kk(2)+i)
580 wa(jj + 3) = lbuf%STRA(kk(3)+i)
581 wa(jj + 4) = lbuf%STRA(kk(4)+i)
582 wa(jj + 5) = lbuf%STRA(kk(5)+i)
583 wa(jj + 6) = lbuf%STRA(kk(6)+i)
584 jj=jj + 6
585 ENDDO
586 ENDDO
587 ENDDO
588 ENDDO
589 ENDDO ! I=LFT,LLT
590 ENDIF
591 ENDIF ! ITENS = 3
592C
593 ENDIF ! ITY == 1.OR.ITY == 2
594 ENDDO ! NG = NGF, NGL
595 ngf = ngl + 1
596 jj_loc(nn) = jj - compteur ! size of each group
597 compteur = jj
598 ENDDO ! nn=1,nspgroup
599! ++++++++++
600 IF( nspmd>1 ) THEN
601 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
602 ELSE
603 wap0_loc(1:jj) = wa(1:jj)
604 adress(1,1) = 1
605 DO nn = 2,nspgroup+1
606 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
607 ENDDO
608 ENDIF
609! ++++++++++
610 IF(ispmd==0) THEN
611 DO nn=1,nspgroup
612 compteur = 0
613 DO k = 1,nspmd
614 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
615 DO l = adress(nn,k),adress(nn+1,k)-1
616 compteur = compteur + 1
617 wap0(compteur) = wap0_loc(l)
618 ENDDO ! l=... , ...
619 ENDIF !if(size_loc>0)
620 ENDDO ! k=1,nspmd
621
622 jj_old = compteur+1
623c--------------------------------
624 IF (jj_old > 1) THEN
625C ICAS_OLD sert a connaitre le "type" du dernier groupe traite
626C on ajoute un commentaire de format a chaque changement
627 icas_old = 0
628 j = 1
629 DO WHILE (j < jj_old)
630C valeur absolue deja stockee dans WA
631 IF (itens == 2) THEN
632 nlay = nint(wap0(j))
633 nptr = nint(wap0(j+1))
634 npts = nint(wap0(j+2))
635 nptt = nint(wap0(j+3))
636 isolnod=nint(wap0(j+4))
637 khbe = nint(wap0(j+5))
638 npt = nptr * npts * nptt * nlay
639 j = j + 6
640 tshell = 0
641 IF (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22) tshell = 1
642c
643 IF (tshell == 1) THEN
644 IF (khbe == 14 .OR. khbe == 16) THEN
645 IF (icas_old /= 1) THEN
646 icas_old = 1
647 IF (outyy_fmt == 2) THEN
648 WRITE(iugeo,'(A)')
649 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
650 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
651 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
652 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
653 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
654 ELSE
655 WRITE(iugeo,'(A)')
656 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
657 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
658 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
659 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
660 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
661 ENDIF
662 ENDIF ! ICAS_OLD
663 IF (outyy_fmt == 2) THEN
664 WRITE(iugeo,'(6I8)') npt,isolnod,khbe,nptr,npts,nptt
665C ecriture sur 2 lignes cf smp !
666 DO i = 1, npt
667 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
668 j = j + 6
669 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
670 j = j + 3
671 ENDDO
672 ELSE
673 WRITE(iugeo,'(6I10)')npt,isolnod,khbe,nptr,npts,nptt
674C ecriture sur 2 lignes cf smp !
675 DO i = 1, npt
676 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
677 j = j + 6
678 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
679 j = j + 3
680 ENDDO
681 ENDIF
682c
683 ELSEIF (khbe == 15) THEN
684 IF (icas_old /= 2) THEN
685 icas_old = 2
686 IF (outyy_fmt == 2) THEN
687 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
688 . '#(NPT ),(3I8),I=1,NUMSOL'
689 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
690 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
691 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
692 ELSE
693 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
694 . '#(NPT ),(3I10),I=1,NUMSOL'
695 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
696 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
697 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
698 ENDIF
699 ENDIF
700 IF (outyy_fmt == 2) THEN
701 WRITE(iugeo,'(3I8)') npt, isolnod, khbe
702C ecriture sur 2 lignes cf smp !
703 DO i = 1, npt
704 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
705 j = j + 6
706 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
707 j = j + 3
708 ENDDO
709 ELSE
710 WRITE(iugeo,'(3I10)') npt, isolnod, khbe
711C ecriture sur 2 lignes cf smp !
712 DO i = 1, npt
713 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
714 j = j + 6
715 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
716 j = j + 3
717 ENDDO
718 ENDIF
719 ENDIF
720c solid properties
721 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
722 . khbe /= 14 .AND. khbe /= 15 .AND. khbe/=17) THEN
723C test cas precedent et ecriture format si besoin
724 IF (icas_old /= 4) THEN
725 icas_old = 4
726 IF (outyy_fmt == 2) THEN
727 WRITE(iugeo,'(A)')
728 . '#FORMAT:(NPT, ISOLNOD (2I8/2E12.5),
729 . EINT(I),RHO(I),,I=1,NUMSOL '
730 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/E12.5) ',
731 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
732 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL)'
733 ELSE
734 WRITE(iugeo,'(A)')
735 . '#FORMAT:(NPT, ISOLNOD (2I10/2E20.13),
736 . EINT(I),RHO(I),,I=1,NUMSOL '
737 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/E20.13) ',
738 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
739 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL)'
740 ENDIF
741 ENDIF
742 IF (outyy_fmt == 2) THEN
743 WRITE(iugeo,'(2I8)')npt,isolnod
744 WRITE(iugeo,'(1P2E12.5)')(wap0(j-1+k),k=1,2)
745 j=j+2
746C ecriture sur 2 lignes cf smp !
747 DO i = 1, npt
748 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
749 j = j + 6
750 WRITE(iugeo,'(1P1E12.5)')wap0(j)
751 j = j + 1
752 ENDDO
753 ELSE
754 WRITE(iugeo,'(2I10)')npt,isolnod
755 WRITE(iugeo,'(1P2E20.13)')(wap0(j-1+k),k=1,2)
756 j=j+2
757C ecriture sur 2 lignes cf smp !
758 DO i = 1, npt
759 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
760 j = j + 6
761 WRITE(iugeo,'(1P1E20.13)')wap0(j)
762 j = j + 1
763 ENDDO
764 ENDIF
765 ELSEIF (isolnod == 8 .AND. (khbe == 14 .OR. khbe == 17)) THEN
766c
767 IF (icas_old /= 3) THEN
768 icas_old = 3
769 IF (outyy_fmt == 2) THEN
770 WRITE(iugeo,'(A)')
771 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
772 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
773 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
774 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
775 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
776 ELSE
777 WRITE(iugeo,'(A)')
778 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
779 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
780 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
781 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
782 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
783 ENDIF
784 ENDIF
785c
786 IF (outyy_fmt == 2) THEN
787 WRITE(iugeo,'(6I8)') npt,isolnod,khbe,nptr,npts,nptt
788C ecriture sur 2 lignes cf smp !
789 DO i = 1, npt
790 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
791 j = j + 6
792 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
793 j = j + 3
794 ENDDO
795 ELSE
796 WRITE(iugeo,'(6I10)')npt,isolnod,khbe,nptr,npts,nptt
797C ecriture sur 2 lignes cf smp !
798 DO i = 1, npt
799 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
800 j = j + 6
801 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
802 j = j + 3
803 ENDDO
804 ENDIF
805c
806 ELSEIF (isolnod == 20) THEN
807 IF(icas_old /= 6) THEN
808 icas_old = 6
809 IF (outyy_fmt == 2) THEN
810 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD,NPTR,NPTS,NPTT',
811 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
812 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
813 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
814 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
815 ELSE
816 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD,NPTR,NPTS,NPTT',
817 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
818 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
819 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
820 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
821 ENDIF
822 ENDIF
823 IF (outyy_fmt == 2) THEN
824 WRITE(iugeo,'(5I8)')npt,isolnod,nptr,npts,nptt
825C ecriture sur 2 lignes cf smp !
826 DO i = 1, npt
827 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
828 j = j + 6
829 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
830 j = j + 3
831 ENDDO
832 ELSE
833 WRITE(iugeo,'(5I10)')npt,isolnod,nptr,npts,nptt
834C ecriture sur 2 lignes cf smp !
835 DO i = 1, npt
836 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
837 j = j + 6
838 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
839 j = j + 3
840 ENDDO
841 ENDIF
842c
843 ELSEIF ((isolnod == 8 .OR. npt == 1) .AND.
844 . khbe /= 14 .AND. khbe /= 15 .AND. khbe /= 17) THEN
845 IF (icas_old /= 5) THEN
846 icas_old = 5
847 IF (outyy_fmt == 2) THEN
848 WRITE(iugeo,'(A)')
849 . '#FORMAT:(NPT, ISOLNOD (2I8/2E12.5),
850 . EINT(I),RHO(I),,I=1,NUMSOL '
851 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/E12.5) ',
852 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
853 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL,NPT=1)'
854 ELSE
855 WRITE(iugeo,'(A)')
856 . '#FORMAT:(NPT, ISOLNOD (2I10/2E20.13),
857 . EINT(I),RHO(I),,I=1,NUMSOL '
858 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/E20.13) ',
859 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
860 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL,NPT=1)'
861 ENDIF
862 ENDIF
863 IF (outyy_fmt == 2) THEN
864 WRITE(iugeo,'(2I8)')npt,isolnod
865 WRITE(iugeo,'(1P2E12.5)')(wap0(j-1+k),k=1,2)
866 j=j+2
867 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
868 j=j+6
869 WRITE(iugeo,'(1P1E12.5)')wap0(j)
870 j = j + 1
871 ELSE
872 WRITE(iugeo,'(2I10)')npt,isolnod
873 WRITE(iugeo,'(1P2E20.13)')(wap0(j-1+k),k=1,2)
874 j=j+2
875 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
876 j=j+6
877 WRITE(iugeo,'(1P1E20.13)')wap0(j)
878 j = j + 1
879 ENDIF
880C le test remis coherent par rapport a SMP
881c
882 ELSEIF (isolnod == 10) THEN
883 IF(icas_old /= 7) THEN
884 icas_old = 7
885 IF (outyy_fmt == 2) THEN
886 WRITE(iugeo,'(A)')
887 . '#FORMAT:(NPT,ISOLNOD,(2I8),I=1,NUMSOL'
888 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
889 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
890 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
891 ELSE
892 WRITE(iugeo,'(A)')
893 . '#FORMAT:(NPT,ISOLNOD,(2I10),I=1,NUMSOL'
894 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
895 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
896 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
897 ENDIF
898 ENDIF
899 IF (outyy_fmt == 2) THEN
900 WRITE(iugeo,'(2I8)')npt,isolnod
901C ecriture sur 2 lignes cf smp !
902 DO i = 1, npt
903 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
904 j = j + 6
905 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
906 j = j + 3
907 ENDDO
908 ELSE
909 WRITE(iugeo,'(2I10)')npt,isolnod
910C ecriture sur 2 lignes cf smp !
911 DO i = 1, npt
912 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
913 j = j + 6
914 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
915 j = j + 3
916 ENDDO
917 ENDIF
918 ELSE
919 IF (icas_old /= 8) THEN
920 icas_old = 8
921 IF (outyy_fmt == 2) THEN
922 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
923 . '#(NPT ),(3I8),I=1,NUMSOL'
924 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
925 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
926 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
927 ELSE
928 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
929 . '#(NPT ),(3I10),I=1,NUMSOL'
930 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
931 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
932 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
933 ENDIF
934 ENDIF
935 IF (outyy_fmt == 2) THEN
936 WRITE(iugeo,'(3I8)') npt, isolnod, khbe
937C ecriture sur 2 lignes cf smp !
938 DO i = 1, npt
939 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
940 j = j + 6
941 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
942 j = j + 3
943 ENDDO
944 ELSE
945 WRITE(iugeo,'(3I10)') npt, isolnod, khbe
946C ecriture sur 2 lignes cf smp !
947 DO i = 1, npt
948 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
949 j = j + 6
950 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
951 j = j + 3
952 ENDDO
953 ENDIF
954 ENDIF
955c-------------------------------
956c /STRAIN
957c-------------------------------
958 ELSEIF(itens == 3)THEN
959 npt = nint(wap0(j))
960 isolnod= nint(wap0(j+1))
961 nel = nint(wap0(j+2))
962 j=j+3
963 IF (icas_old /= 10) THEN
964 icas_old = 10
965 IF (outyy_fmt == 2) THEN
966 WRITE(iugeo,'(A)')
967 . '#FORMAT:(NPT, ISOLNOD, NUMSOL (3I8)'
968 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5) ',
969 . '((EXX(I,J),EYY(I,J),EZZ(I,J),EXY(I,J),EYZ(I,J),EZX(I,J),',
970 . '#J=1,NPT),I=1,NUMSOL)'
971 ELSE
972 WRITE(iugeo,'(A)')
973 . '#FORMAT:(NPT, ISOLNOD, NUMSOL (3I10)'
974 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13) ',
975 . '((EXX(I,J),EYY(I,J),EZZ(I,J),EXY(I,J),EYZ(I,J),EZX(I,J),',
976 . '#J=1,NPT),I=1,NUMSOL)'
977 ENDIF
978 ENDIF
979c
980 IF(outyy_fmt == 2)THEN
981 WRITE(iugeo,'(3I8)') npt, isolnod,nel
982 DO i = 1,nel
983 DO ipt = 1, npt
984 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
985 j = j + 6
986 ENDDO
987 ENDDO
988 ELSE
989 WRITE(iugeo,'(3I10)') npt,isolnod,nel
990 DO i=1,nel
991 DO ipt = 1, npt
992 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
993 j = j + 6
994 ENDDO
995 ENDDO
996 ENDIF
997c
998 ENDIF ! ITENS
999c-------------------------------
1000 ENDDO ! WHILE (J < JJ_OLD)
1001 ENDIF ! jj_old>1
1002 ENDDO ! nn=1,nspgroup
1003 ENDIF ! ispmd==0
1004C-----------
1005 RETURN
1006 END
1007!||====================================================================
1008!|| count_arsz_st ../engine/source/output/sty/outp_s_t.F
1009!||--- called by ------------------------------------------------------
1010!|| genoutp ../engine/source/output/sty/genoutp.F
1011!|| outp_arsz_st ../engine/source/mpi/interfaces/spmd_outp.F
1012!||--- uses -----------------------------------------------------
1013!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1014!||====================================================================
1015 SUBROUTINE count_arsz_st(IPARG,DD_IAD,WASZ,SZP0)
1016C-----------------------------------------------
1017C M o d u l e s
1018C-----------------------------------------------
1019 USE elbufdef_mod
1020C-----------------------------------------------
1021C I m p l i c i t T y p e s
1022C-----------------------------------------------
1023#include "implicit_f.inc"
1024C-----------------------------------------------
1025C C o m m o n B l o c k s
1026C-----------------------------------------------
1027#include "com01_c.inc"
1028#include "scr16_c.inc"
1029#include "task_c.inc"
1030#include "param_c.inc"
1031C-----------------------------------------------
1032C D u m m y A r g u m e n t s
1033C-----------------------------------------------
1034 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),WASZ(3)
1035C-----------------------------------------------
1036C L o c a l V a r i a b l e s
1037C-----------------------------------------------
1038 INTEGER NGL,ITY,NRL,KHBE,MLW,NPT,ISOLNOD,NGF,NN,NEL,
1039 . NG,NLAY,NPTR,NPTS,NPTT,NPTG,JJ,
1040 . szp0(3*nspgroup+3)
1041C=======================================================================
1042 wasz = 0
1043 szp0 = 0
1044c------------------------------
1045 IF (outp_st(1) == 1) THEN
1046 ngf = 1
1047 ngl = 0
1048 DO nn=1,nspgroup
1049 jj = 0
1050 ngl = ngl + dd_iad(ispmd+1,nn)
1051 DO ng = ngf, ngl
1052 ity =iparg(5,ng)
1053 IF (ity == 1.OR.ity == 2) THEN
1054 nel =iparg(2,ng)
1055
1056 jj = jj + 6*nel
1057 ENDIF
1058 ENDDO
1059 ngf = ngl + 1
1060 wasz(1) = wasz(1)+jj
1061 szp0(nn)=jj
1062 ENDDO
1063 szp0(3*nspgroup+1) = wasz(1)
1064 END IF
1065c------------------------------
1066 IF (outp_st(2) == 1) THEN
1067 ngf = 1
1068 ngl = 0
1069 DO nn=1,nspgroup
1070 jj = 0
1071 ngl = ngl + dd_iad(ispmd+1,nn)
1072 DO ng = ngf, ngl
1073 ity =iparg(5,ng)
1074 IF (ity == 1 .OR. ity == 2) THEN
1075 mlw = iparg(1,ng)
1076 nel = iparg(2,ng)
1077 khbe = iparg(23,ng)
1078 npt = abs(iparg(6,ng))
1079 isolnod=iparg(28,ng)
1080C
1081 IF (isolnod == 8 .AND. (khbe == 14.OR.khbe == 17)) THEN
1082 jj = jj + nel*(6+9*npt)
1083 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
1084 . khbe /= 14 .AND. khbe /= 15) THEN
1085 jj = jj + nel*(8+7*npt)
1086 ELSEIF ((isolnod == 8 .OR. npt == 1) .AND.
1087 . khbe /= 14.AND.khbe /= 15.AND.khbe /= 17) THEN
1088 jj = jj + nel*(8+7*npt)
1089 ELSE
1090 jj = jj + nel*(6+9*npt)
1091 ENDIF
1092 ENDIF
1093 ENDDO
1094 szp0(nspgroup+nn)=jj
1095 wasz(2) = wasz(2)+jj
1096 ngf = ngl + 1
1097 ENDDO
1098 szp0(3*nspgroup+2)=wasz(2)
1099 ENDIF
1100C
1101C strain/full
1102 IF (outp_st(3) == 1) THEN
1103 ngf = 1
1104 ngl = 0
1105 DO nn=1,nspgroup
1106 jj = 0
1107 ngl = ngl + dd_iad(ispmd+1,nn)
1108 DO ng = ngf, ngl
1109 ity =iparg(5,ng)
1110 IF(ity == 1.OR.ity == 2) THEN
1111 mlw =iparg(1,ng)
1112 nel =iparg(2,ng)
1113 khbe =iparg(23,ng)
1114 npt =abs(iparg(6,ng))
1115 isolnod=iparg(28,ng)
1116 jj = jj + 3 + nel*npt*6
1117 ENDIF
1118 ENDDO
1119 szp0(2*nspgroup+nn)=jj
1120 wasz(3) = wasz(3)+jj
1121 ngf = ngl + 1
1122 ENDDO
1123 szp0(3*nspgroup+3) = wasz(3)
1124 ENDIF
1125C
1126 RETURN
1127 END
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
outp_s_tt
subroutine outp_s_tt(nbx, key, text, elbuf_tab, iparg, dd_iad, ipm, ixs, sizloc, sizp0, siz_wr)
Definition outp_s_t.F:196
count_arsz_st
subroutine count_arsz_st(iparg, dd_iad, wasz, szp0)
Definition outp_s_t.F:1016
outp_s_t
subroutine outp_s_t(nbx, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
Definition outp_s_t.F:36
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1177