OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_s_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"

Go to the source code of this file.

Functions/Subroutines

subroutine outp_s_t (nbx, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
subroutine outp_s_tt (nbx, key, text, elbuf_tab, iparg, dd_iad, ipm, ixs, sizloc, sizp0, siz_wr)
subroutine count_arsz_st (iparg, dd_iad, wasz, szp0)

Function/Subroutine Documentation

◆ count_arsz_st()

subroutine count_arsz_st ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(3) wasz,
integer, dimension(3*nspgroup+3) szp0 )

Definition at line 1017 of file outp_s_t.F.

1018C-----------------------------------------------
1019C M o d u l e s
1020C-----------------------------------------------
1021 USE elbufdef_mod
1022C-----------------------------------------------
1023C I m p l i c i t T y p e s
1024C-----------------------------------------------
1025#include "implicit_f.inc"
1026C-----------------------------------------------
1027C C o m m o n B l o c k s
1028C-----------------------------------------------
1029#include "com01_c.inc"
1030#include "scr16_c.inc"
1031#include "task_c.inc"
1032#include "param_c.inc"
1033C-----------------------------------------------
1034C D u m m y A r g u m e n t s
1035C-----------------------------------------------
1036 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),WASZ(3)
1037C-----------------------------------------------
1038C L o c a l V a r i a b l e s
1039C-----------------------------------------------
1040 INTEGER NGL, ITY, KHBE, MLW, NPT, ISOLNOD, NGF, NN, NEL,
1041 . NG,NLAY,NPTR,NPTS,NPTT,NPTG,JJ,
1042 . SZP0(3*NSPGROUP+3)
1043C=======================================================================
1044 wasz = 0
1045 szp0 = 0
1046c------------------------------
1047 IF (outp_st(1) == 1) THEN
1048 ngf = 1
1049 ngl = 0
1050 DO nn=1,nspgroup
1051 jj = 0
1052 ngl = ngl + dd_iad(ispmd+1,nn)
1053 DO ng = ngf, ngl
1054 ity =iparg(5,ng)
1055 IF (ity == 1.OR.ity == 2) THEN
1056 nel =iparg(2,ng)
1057
1058 jj = jj + 6*nel
1059 ENDIF
1060 ENDDO
1061 ngf = ngl + 1
1062 wasz(1) = wasz(1)+jj
1063 szp0(nn)=jj
1064 ENDDO
1065 szp0(3*nspgroup+1) = wasz(1)
1066 END IF
1067c------------------------------
1068 IF (outp_st(2) == 1) THEN
1069 ngf = 1
1070 ngl = 0
1071 DO nn=1,nspgroup
1072 jj = 0
1073 ngl = ngl + dd_iad(ispmd+1,nn)
1074 DO ng = ngf, ngl
1075 ity =iparg(5,ng)
1076 IF (ity == 1 .OR. ity == 2) THEN
1077 mlw = iparg(1,ng)
1078 nel = iparg(2,ng)
1079 khbe = iparg(23,ng)
1080 npt = abs(iparg(6,ng))
1081 isolnod=iparg(28,ng)
1082C
1083 IF (isolnod == 8 .AND. (khbe == 14.OR.khbe == 17)) THEN
1084 jj = jj + nel*(6+9*npt)
1085 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
1086 . khbe /= 14 .AND. khbe /= 15) THEN
1087 jj = jj + nel*(8+7*npt)
1088 ELSEIF ((isolnod == 8 .OR. npt == 1) .AND.
1089 . khbe /= 14.AND.khbe /= 15.AND.khbe /= 17) THEN
1090 jj = jj + nel*(8+7*npt)
1091 ELSE
1092 jj = jj + nel*(6+9*npt)
1093 ENDIF
1094 ENDIF
1095 ENDDO
1096 szp0(nspgroup+nn)=jj
1097 wasz(2) = wasz(2)+jj
1098 ngf = ngl + 1
1099 ENDDO
1100 szp0(3*nspgroup+2)=wasz(2)
1101 ENDIF
1102C
1103C strain/full
1104 IF (outp_st(3) == 1) THEN
1105 ngf = 1
1106 ngl = 0
1107 DO nn=1,nspgroup
1108 jj = 0
1109 ngl = ngl + dd_iad(ispmd+1,nn)
1110 DO ng = ngf, ngl
1111 ity =iparg(5,ng)
1112 IF(ity == 1.OR.ity == 2) THEN
1113 mlw =iparg(1,ng)
1114 nel =iparg(2,ng)
1115 khbe =iparg(23,ng)
1116 npt =abs(iparg(6,ng))
1117 isolnod=iparg(28,ng)
1118 jj = jj + 3 + nel*npt*6
1119 ENDIF
1120 ENDDO
1121 szp0(2*nspgroup+nn)=jj
1122 wasz(3) = wasz(3)+jj
1123 ngf = ngl + 1
1124 ENDDO
1125 szp0(3*nspgroup+3) = wasz(3)
1126 ENDIF
1127C
1128 RETURN

◆ outp_s_t()

subroutine outp_s_t ( integer nbx,
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_s_t.F.

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, RESP0, WRTLEN, RES
66 INTEGER NG, NEL,
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
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:1181

◆ outp_s_tt()

subroutine outp_s_tt ( integer nbx,
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(nixs,*) ixs,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 195 of file outp_s_t.F.

197C-----------------------------------------------
198C M o d u l e s
199C-----------------------------------------------
200 USE initbuf_mod
201 USE elbufdef_mod
202 use element_mod , only : nixs
203C-----------------------------------------------
204C I m p l i c i t T y p e s
205C-----------------------------------------------
206#include "implicit_f.inc"
207C-----------------------------------------------
208C C o m m o n B l o c k s
209C-----------------------------------------------
210#include "vect01_c.inc"
211#include "com01_c.inc"
212#include "param_c.inc"
213#include "units_c.inc"
214#include "task_c.inc"
215#include "scr16_c.inc"
216C-----------------------------------------------
217C D u m m y A r g u m e n t s
218C-----------------------------------------------
219 CHARACTER*10 KEY
220 CHARACTER*40 TEXT
221 INTEGER IXS(NIXS,*),IPM(NPROPMI,*),IPARG(NPARG,*),
222 . DD_IAD(NSPMD+1,*)
223 INTEGER NBX,SIZLOC,SIZP0,SIZ_WR
224 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
225C-----------------------------------------------
226C L o c a l V a r i a b l e s
227C-----------------------------------------------
228 INTEGER I, J, K, JJ, NLAY, NPTR, NPTS, NPTT, IL, IR, IS, IT, IPT,
229 . NG, NEL, IADD, MLW,JJ_OLD, NGF, NGL, NN, LEN, ICAS_OLD,
230 . ISOLNOD,KHBE,ITENS,TSHELL,COMPTEUR,L,KK(6)
231 my_real
232 . func(6)
233 INTEGER, DIMENSION(NSPGROUP) :: JJ_LOC
234 INTEGER, DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
235 my_real
236 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
237 TYPE(G_BUFEL_) ,POINTER :: GBUF
238 TYPE(L_BUFEL_) ,POINTER :: LBUF
239C=======================================================================
240 itens = nbx
241c-----------------------
242 IF (ispmd == 0) THEN
243 WRITE(iugeo,'(2A)')'/SOLID /TENSOR /',key
244 WRITE(iugeo,'(A)')text
245 ENDIF
246C
247 jj_old = 1
248 ngf = 1
249 ngl = 0
250 jj = 0
251 compteur = 0
252 DO nn=1,nspgroup
253 ngl = ngl + dd_iad(ispmd+1,nn)
254 DO ng = ngf, ngl
255 ity =iparg(5,ng)
256 IF (ity == 1.OR.ity == 2) THEN
257 CALL initbuf(iparg ,ng ,
258 2 mlw ,nel ,nft ,iad ,ity ,
259 3 npt ,jale ,ismstr ,jeul ,jtur ,
260 4 jthe ,jlag ,jmult ,khbe ,jivf ,
261 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
262 6 irep ,iint ,igtyp ,israt ,isrot ,
263 7 icsen ,isorth ,isorthg ,ifailure,jsms )
264 gbuf => elbuf_tab(ng)%GBUF
265 nlay = elbuf_tab(ng)%NLAY
266 nptr = elbuf_tab(ng)%NPTR
267 npts = elbuf_tab(ng)%NPTS
268 nptt = elbuf_tab(ng)%NPTT
269 npt = nptr * npts * nptt * nlay
270 lft=1
271 llt=nel
272 isolnod=iparg(28,ng)
273 tshell = 0
274 IF (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22) tshell = 1
275!
276 DO i=1,6
277 kk(i) = nel*(i-1)
278 ENDDO
279!
280C--------------------------------------
281 IF (itens == 2)THEN
282C /outp/brick/stress/full
283C------------------------------------
284 IF (tshell == 1) THEN
285 IF (khbe == 14 .OR. khbe == 16) THEN
286 DO i=lft,llt
287 wa(jj+1) = nlay
288 wa(jj+2) = nptr
289 wa(jj+3) = npts
290 wa(jj+4) = nptt
291 wa(jj+5) = abs(isolnod)
292 wa(jj+6) = iabs(khbe)
293 jj = jj + 6
294 DO ir=1,nptr
295 DO is=1,npts
296 DO it=1,nptt
297 DO il=1,nlay
298 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
299 wa(jj + 1) = lbuf%SIG(kk(1)+i)
300 wa(jj + 2) = lbuf%SIG(kk(2)+i)
301 wa(jj + 3) = lbuf%SIG(kk(3)+i)
302 wa(jj + 4) = lbuf%SIG(kk(4)+i)
303 wa(jj + 5) = lbuf%SIG(kk(5)+i)
304 wa(jj + 6) = lbuf%SIG(kk(6)+i)
305 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
306 wa(jj + 7) = zero
307 ELSE
308 wa(jj + 7) = lbuf%PLA(i)
309 ENDIF
310 wa(jj+8) = lbuf%EINT(i)
311 wa(jj+9) = lbuf%RHO(i)
312 jj = jj + 9
313 ENDDO ! IT=1,NPTT
314 ENDDO ! IS=1,NPTS
315 ENDDO ! IR=1,NPTR
316 ENDDO ! IL=1,NLAY
317 ENDDO ! I=LFT,LLT
318 ELSEIF (khbe == 15) THEN
319 DO i=lft,llt
320 wa(jj+1) = nlay
321 wa(jj+2) = nptr
322 wa(jj+3) = npts
323 wa(jj+4) = nptt
324 wa(jj+5) = abs(isolnod)
325 wa(jj+6) = iabs(khbe)
326 jj = jj + 6
327 DO il=1,nlay
328 DO ir=1,nptr
329 DO is=1,npts
330 DO it=1,nptt
331 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
332 wa(jj + 1) = lbuf%SIG(kk(1)+i)
333 wa(jj + 2) = lbuf%SIG(kk(2)+i)
334 wa(jj + 3) = lbuf%SIG(kk(3)+i)
335 wa(jj + 4) = lbuf%SIG(kk(4)+i)
336 wa(jj + 5) = lbuf%SIG(kk(5)+i)
337 wa(jj + 6) = lbuf%SIG(kk(6)+i)
338 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
339 wa(jj + 7) = zero
340 ELSE
341 wa(jj + 7) = lbuf%PLA(i)
342 ENDIF
343 wa(jj+8) = lbuf%EINT(i)
344 wa(jj+9) = lbuf%RHO(i)
345 jj = jj + 9
346 ENDDO ! IT=1,NPTT
347 ENDDO ! IS=1,NPTS
348 ENDDO ! IR=1,NPTR
349 ENDDO ! IL=1,NLAY
350 ENDDO ! I=LFT,LLT
351 ENDIF
352 ELSEIF (khbe == 14 .OR. khbe == 17 .OR. isolnod == 20 .OR.
353 . isolnod == 16) THEN
354 DO i=lft,llt
355 wa(jj+1) = nlay
356 wa(jj+2) = nptr
357 wa(jj+3) = npts
358 wa(jj+4) = nptt
359 wa(jj+5) = abs(isolnod)
360 wa(jj+6) = iabs(khbe)
361 jj = jj + 6
362 DO il=1,nlay
363 DO it=1,nptt
364 DO is=1,npts
365 DO ir=1,nptr
366 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
367 wa(jj + 1) = lbuf%SIG(kk(1)+i)
368 wa(jj + 2) = lbuf%SIG(kk(2)+i)
369 wa(jj + 3) = lbuf%SIG(kk(3)+i)
370 wa(jj + 4) = lbuf%SIG(kk(4)+i)
371 wa(jj + 5) = lbuf%SIG(kk(5)+i)
372 wa(jj + 6) = lbuf%SIG(kk(6)+i)
373 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
374 wa(jj + 7) = zero
375 ELSE
376 wa(jj + 7) = lbuf%PLA(i)
377 ENDIF
378 wa(jj+8) = lbuf%EINT(i)
379 wa(jj+9) = lbuf%RHO(i)
380 jj = jj + 9
381 ENDDO ! IT=1,NPTT
382 ENDDO ! IS=1,NPTS
383 ENDDO ! IR=1,NPTR
384 ENDDO ! IL=1,NLAY
385 ENDDO ! I=LFT,LLT
386c
387 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
388 . khbe /= 14 .AND. khbe /= 15 ) THEN
389 DO i=lft,llt
390 wa(jj+1) = nlay
391 wa(jj+2) = nptr
392 wa(jj+3) = npts
393 wa(jj+4) = nptt
394 wa(jj+5) = abs(isolnod)
395 wa(jj+6) = iabs(khbe)
396 wa(jj+7) = gbuf%EINT(i)
397 wa(jj+8) = gbuf%RHO(i)
398 jj = jj + 8
399 DO il=1,nlay
400 DO ir=1,nptr
401 DO is=1,npts
402 DO it=1,nptt
403 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
404 wa(jj + 1) = lbuf%SIG(kk(1)+i)
405 wa(jj + 2) = lbuf%SIG(kk(2)+i)
406 wa(jj + 3) = lbuf%SIG(kk(3)+i)
407 wa(jj + 4) = lbuf%SIG(kk(4)+i)
408 wa(jj + 5) = lbuf%SIG(kk(5)+i)
409 wa(jj + 6) = lbuf%SIG(kk(6)+i)
410 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
411 wa(jj + 7) = zero
412 ELSE
413 wa(jj + 7) = lbuf%PLA(i)
414 ENDIF
415 jj = jj + 7
416 ENDDO ! IT=1,NPTT
417 ENDDO ! IS=1,NPTS
418 ENDDO ! IR=1,NPTR
419 ENDDO ! IL=1,NLAY
420 ENDDO ! I=LFT,LLT
421c
422 ELSEIF (isolnod == 10) THEN
423 DO i=lft,llt
424 wa(jj+1) = nlay
425 wa(jj+2) = nptr
426 wa(jj+3) = npts
427 wa(jj+4) = nptt
428 wa(jj+5) = abs(isolnod)
429 wa(jj+6) = iabs(khbe)
430 jj = jj + 6
431 DO il=1,nlay
432 DO ir=1,nptr
433 DO is=1,npts
434 DO it=1,nptt
435 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
436 wa(jj + 1) = lbuf%SIG(kk(1)+i)
437 wa(jj + 2) = lbuf%SIG(kk(2)+i)
438 wa(jj + 3) = lbuf%SIG(kk(3)+i)
439 wa(jj + 4) = lbuf%SIG(kk(4)+i)
440 wa(jj + 5) = lbuf%SIG(kk(5)+i)
441 wa(jj + 6) = lbuf%SIG(kk(6)+i)
442 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
443 wa(jj + 7) = zero
444 ELSE
445 wa(jj + 7) = lbuf%PLA(i)
446 ENDIF
447 wa(jj+8) = lbuf%EINT(i)
448 wa(jj+9) = lbuf%RHO(i)
449 jj = jj + 9
450 ENDDO ! IT=1,NPTT
451 ENDDO ! IS=1,NPTS
452 ENDDO ! IR=1,NPTR
453 ENDDO ! IL=1,NLAY
454 ENDDO ! I=LFT,LLT
455c
456 ELSEIF ((isolnod == 6.OR.isolnod == 8).AND.
457 . khbe == 15) THEN
458 DO i=lft,llt
459 wa(jj+1) = nlay
460 wa(jj+2) = nptr
461 wa(jj+3) = npts
462 wa(jj+4) = nptt
463 wa(jj+5) = abs(isolnod)
464 wa(jj+6) = iabs(khbe)
465 jj = jj + 6
466 DO il=1,nlay
467 DO ir=1,nptr
468 DO is=1,npts
469 DO it=1,nptt
470 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
471 wa(jj + 1) = lbuf%SIG(kk(1)+i)
472 wa(jj + 2) = lbuf%SIG(kk(2)+i)
473 wa(jj + 3) = lbuf%SIG(kk(3)+i)
474 wa(jj + 4) = lbuf%SIG(kk(4)+i)
475 wa(jj + 5) = lbuf%SIG(kk(5)+i)
476 wa(jj + 6) = lbuf%SIG(kk(6)+i)
477 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA == 0) THEN
478 wa(jj + 7) = zero
479 ELSE
480 wa(jj + 7) = lbuf%PLA(i)
481 ENDIF
482 wa(jj+8) = lbuf%EINT(i)
483 wa(jj+9) = lbuf%RHO(i)
484 jj = jj + 9
485 ENDDO ! IT=1,NPTT
486 ENDDO ! IS=1,NPTS
487 ENDDO ! IR=1,NPTR
488 ENDDO ! IL=1,NLAY
489 ENDDO ! I=LFT,LLT
490c-------------
491 ELSE ! one integration pt, Isolid = 0,1,2,24
492c-------------
493 DO i=lft,llt
494 wa(jj+1) = nlay
495 wa(jj+2) = nptr
496 wa(jj+3) = npts
497 wa(jj+4) = nptt
498 wa(jj+5) = abs(isolnod)
499 wa(jj+6) = iabs(khbe)
500 wa(jj+7) = gbuf%EINT(i)
501 wa(jj+8) = gbuf%RHO(i)
502 jj = jj + 8
503 wa(jj + 1) = gbuf%SIG(kk(1)+i)
504 wa(jj + 2) = gbuf%SIG(kk(2)+i)
505 wa(jj + 3) = gbuf%SIG(kk(3)+i)
506 wa(jj + 4) = gbuf%SIG(kk(4)+i)
507 wa(jj + 5) = gbuf%SIG(kk(5)+i)
508 wa(jj + 6) = gbuf%SIG(kk(6)+i)
509 IF (gbuf%G_PLA == 0) THEN
510 wa(jj + 7) = zero
511 ELSE
512 wa(jj + 7) = gbuf%PLA(i)
513 ENDIF
514 jj = jj + 7
515 ENDDO ! I=LFT,LLT
516 ENDIF
517C--------------------------------------
518 ELSEIF (itens == 3)THEN
519c /outp/brick/strain/full
520C--------------------------------------
521 wa(jj+1) = npt
522 wa(jj+2) = isolnod
523 wa(jj+3) = nel
524 jj = jj+3
525 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA == 0) THEN
526 DO i=lft,llt
527 wa(jj + 1) = zero
528 wa(jj + 2) = zero
529 wa(jj + 3) = zero
530 wa(jj + 4) = zero
531 wa(jj + 5) = zero
532 wa(jj + 6) = zero
533 jj=jj + 6
534 ENDDO ! I=LFT,LLT
535 ELSEIF (mlw == 14) THEN
536 DO i=lft,llt
537 DO il=1,nlay
538 DO ir=1,nptr
539 DO is=1,npts
540 DO it=1,nptt
541 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
542 wa(jj + 1) = lbuf%EPE(kk(1)+i)
543 wa(jj + 2) = lbuf%EPE(kk(2)+i)
544 wa(jj + 3) = lbuf%EPE(kk(3)+i)
545 wa(jj + 4) = zero
546 wa(jj + 5) = zero
547 wa(jj + 6) = zero
548 jj=jj + 6
549 ENDDO
550 ENDDO
551 ENDDO
552 ENDDO
553 ENDDO
554 ELSEIF (tshell == 1) THEN
555 DO i=lft,llt
556 DO ir=1,nptr
557 DO is=1,npts
558 DO it=1,nptt
559 DO il=1,nlay
560 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
561 wa(jj + 1) = lbuf%STRA(kk(1)+i)
562 wa(jj + 2) = lbuf%STRA(kk(2)+i)
563 wa(jj + 3) = lbuf%STRA(kk(3)+i)
564 wa(jj + 4) = lbuf%STRA(kk(4)+i)
565 wa(jj + 5) = lbuf%STRA(kk(5)+i)
566 wa(jj + 6) = lbuf%STRA(kk(6)+i)
567 jj=jj + 6
568 ENDDO
569 ENDDO
570 ENDDO
571 ENDDO
572 ENDDO ! I=LFT,LLT
573 ELSE
574 DO i=lft,llt
575 DO il=1,nlay
576 DO it=1,nptt
577 DO is=1,npts
578 DO ir=1,nptr
579 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
580 wa(jj + 1) = lbuf%STRA(kk(1)+i)
581 wa(jj + 2) = lbuf%STRA(kk(2)+i)
582 wa(jj + 3) = lbuf%STRA(kk(3)+i)
583 wa(jj + 4) = lbuf%STRA(kk(4)+i)
584 wa(jj + 5) = lbuf%STRA(kk(5)+i)
585 wa(jj + 6) = lbuf%STRA(kk(6)+i)
586 jj=jj + 6
587 ENDDO
588 ENDDO
589 ENDDO
590 ENDDO
591 ENDDO ! I=LFT,LLT
592 ENDIF
593 ENDIF ! ITENS = 3
594C
595 ENDIF ! ITY == 1.OR.ITY == 2
596 ENDDO ! NG = NGF, NGL
597 ngf = ngl + 1
598 jj_loc(nn) = jj - compteur ! size of each group
599 compteur = jj
600 ENDDO ! nn = 1, nspgroup
601! ++++++++++
602 IF( nspmd>1 ) THEN
603 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
604 ELSE
605 wap0_loc(1:jj) = wa(1:jj)
606 adress(1,1) = 1
607 DO nn = 2,nspgroup+1
608 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
609 ENDDO
610 ENDIF
611! ++++++++++
612 IF(ispmd==0) THEN
613 DO nn=1,nspgroup
614 compteur = 0
615 DO k = 1,nspmd
616 IF((adress(nn+1,k)-1-adress(nn,k))>=0) THEN
617 DO l = adress(nn,k),adress(nn+1,k)-1
618 compteur = compteur + 1
619 wap0(compteur) = wap0_loc(l)
620 ENDDO ! l=... , ...
621 ENDIF !if(size_loc>0)
622 ENDDO ! k=1,nspmd
623
624 jj_old = compteur+1
625c--------------------------------
626 IF (jj_old > 1) THEN
627C Icas_old is used to know the "type" of the last group deals
628C a format comment is added at each change
629 icas_old = 0
630 j = 1
631 DO WHILE (j < jj_old)
632C Absolute value already stores in wa
633 IF (itens == 2) THEN
634 nlay = nint(wap0(j))
635 nptr = nint(wap0(j+1))
636 npts = nint(wap0(j+2))
637 nptt = nint(wap0(j+3))
638 isolnod=nint(wap0(j+4))
639 khbe = nint(wap0(j+5))
640 npt = nptr * npts * nptt * nlay
641 j = j + 6
642 tshell = 0
643 IF (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22) tshell = 1
644c
645 IF (tshell == 1) THEN
646 IF (khbe == 14 .OR. khbe == 16) THEN
647 IF (icas_old /= 1) THEN
648 icas_old = 1
649 IF (outyy_fmt == 2) THEN
650 WRITE(iugeo,'(A)')
651 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
652 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
653 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
654 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
655 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
656 ELSE
657 WRITE(iugeo,'(A)')
658 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
659 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
660 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
661 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
662 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
663 ENDIF
664 ENDIF ! ICAS_OLD
665 IF (outyy_fmt == 2) THEN
666 WRITE(iugeo,'(6I8)') npt,isolnod,khbe,nptr,npts,nptt
667C Writing on 2 lines for SMP compatibility
668 DO i = 1, npt
669 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
670 j = j + 6
671 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
672 j = j + 3
673 ENDDO
674 ELSE
675 WRITE(iugeo,'(6I10)')npt,isolnod,khbe,nptr,npts,nptt
676C Writing on 2 lines for SMP compatibility
677 DO i = 1, npt
678 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
679 j = j + 6
680 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
681 j = j + 3
682 ENDDO
683 ENDIF
684c
685 ELSEIF (khbe == 15) THEN
686 IF (icas_old /= 2) THEN
687 icas_old = 2
688 IF (outyy_fmt == 2) THEN
689 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
690 . '#(NPT ),(3I8),I=1,NUMSOL'
691 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
692 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
693 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
694 ELSE
695 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
696 . '#(NPT ),(3I10),I=1,NUMSOL'
697 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
698 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
699 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
700 ENDIF
701 ENDIF
702 IF (outyy_fmt == 2) THEN
703 WRITE(iugeo,'(3I8)') npt, isolnod, khbe
704C Writing on 2 lines for SMP compatibility
705 DO i = 1, npt
706 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
707 j = j + 6
708 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
709 j = j + 3
710 ENDDO
711 ELSE
712 WRITE(iugeo,'(3I10)') npt, isolnod, khbe
713C Writing on 2 lines for SMP compatibility
714 DO i = 1, npt
715 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
716 j = j + 6
717 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
718 j = j + 3
719 ENDDO
720 ENDIF
721 ENDIF
722c solid properties
723 ELSEIF (isolnod == 8 .AND. npt == 8 .AND.
724 . khbe /= 14 .AND. khbe /= 15 .AND. khbe/=17) THEN
725C Precedent case test and format writing if necessary
726 IF (icas_old /= 4) THEN
727 icas_old = 4
728 IF (outyy_fmt == 2) THEN
729 WRITE(iugeo,'(A)')
730 . '#FORMAT:(NPT, ISOLNOD (2I8/2E12.5),
731 . EINT(I),RHO(I),,I=1,NUMSOL '
732 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/E12.5) ',
733 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
734 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL)'
735 ELSE
736 WRITE(iugeo,'(A)')
737 . '#FORMAT:(NPT, ISOLNOD (2I10/2E20.13),
738 . EINT(I),RHO(I),,I=1,NUMSOL '
739 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/E20.13) ',
740 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
741 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL)'
742 ENDIF
743 ENDIF
744 IF (outyy_fmt == 2) THEN
745 WRITE(iugeo,'(2I8)')npt,isolnod
746 WRITE(iugeo,'(1P2E12.5)')(wap0(j-1+k),k=1,2)
747 j=j+2
748C Writing on 2 lines for SMP compatibility
749 DO i = 1, npt
750 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
751 j = j + 6
752 WRITE(iugeo,'(1P1E12.5)')wap0(j)
753 j = j + 1
754 ENDDO
755 ELSE
756 WRITE(iugeo,'(2I10)')npt,isolnod
757 WRITE(iugeo,'(1P2E20.13)')(wap0(j-1+k),k=1,2)
758 j=j+2
759C Writing on 2 lines for SMP compatibility
760 DO i = 1, npt
761 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
762 j = j + 6
763 WRITE(iugeo,'(1P1E20.13)')wap0(j)
764 j = j + 1
765 ENDDO
766 ENDIF
767 ELSEIF (isolnod == 8 .AND. (khbe == 14 .OR. khbe == 17)) THEN
768c
769 IF (icas_old /= 3) THEN
770 icas_old = 3
771 IF (outyy_fmt == 2) THEN
772 WRITE(iugeo,'(A)')
773 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
774 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
775 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
776 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
777 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
778 ELSE
779 WRITE(iugeo,'(A)')
780 . '#FORMAT:(NPT,ISOLNOD,KHBE,NPTR,NPTS,NPTT',
781 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
782 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
783 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
784 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
785 ENDIF
786 ENDIF
787c
788 IF (outyy_fmt == 2) THEN
789 WRITE(iugeo,'(6I8)') npt,isolnod,khbe,nptr,npts,nptt
790C Writing on 2 lines for SMP compatibility
791 DO i = 1, npt
792 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
793 j = j + 6
794 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
795 j = j + 3
796 ENDDO
797 ELSE
798 WRITE(iugeo,'(6I10)')npt,isolnod,khbe,nptr,npts,nptt
799C Writing on 2 lines for SMP compatibility
800 DO i = 1, npt
801 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
802 j = j + 6
803 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
804 j = j + 3
805 ENDDO
806 ENDIF
807c
808 ELSEIF (isolnod == 20) THEN
809 IF(icas_old /= 6) THEN
810 icas_old = 6
811 IF (outyy_fmt == 2) THEN
812 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD,NPTR,NPTS,NPTT',
813 . '#(NPT = NPTR * NPTS * NPTT),(5I8),I=1,NUMSOL'
814 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
815 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
816 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
817 ELSE
818 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD,NPTR,NPTS,NPTT',
819 . '#(NPT = NPTR * NPTS * NPTT),(5I10),I=1,NUMSOL'
820 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
821 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
822 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
823 ENDIF
824 ENDIF
825 IF (outyy_fmt == 2) THEN
826 WRITE(iugeo,'(5I8)')npt,isolnod,nptr,npts,nptt
827C Writing on 2 lines for SMP compatibility
828 DO i = 1, npt
829 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
830 j = j + 6
831 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
832 j = j + 3
833 ENDDO
834 ELSE
835 WRITE(iugeo,'(5I10)')npt,isolnod,nptr,npts,nptt
836C Writing on 2 lines for SMP compatibility
837 DO i = 1, npt
838 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
839 j = j + 6
840 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
841 j = j + 3
842 ENDDO
843 ENDIF
844c
845 ELSEIF ((isolnod == 8 .OR. npt == 1) .AND.
846 . khbe /= 14 .AND. khbe /= 15 .AND. khbe /= 17) THEN
847 IF (icas_old /= 5) THEN
848 icas_old = 5
849 IF (outyy_fmt == 2) THEN
850 WRITE(iugeo,'(A)')
851 . '#FORMAT:(NPT, ISOLNOD (2I8/2E12.5),
852 . EINT(I),RHO(I),,I=1,NUMSOL '
853 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/E12.5) ',
854 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
855 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL,NPT=1)'
856 ELSE
857 WRITE(iugeo,'(A)')
858 . '#FORMAT:(NPT, ISOLNOD (2I10/2E20.13),
859 . EINT(I),RHO(I),,I=1,NUMSOL '
860 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/E20.13) ',
861 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
862 . '#EPSP(J,I),J=1,NPT),I=1,NUMSOL,NPT=1)'
863 ENDIF
864 ENDIF
865 IF (outyy_fmt == 2) THEN
866 WRITE(iugeo,'(2I8)')npt,isolnod
867 WRITE(iugeo,'(1P2E12.5)')(wap0(j-1+k),k=1,2)
868 j=j+2
869 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
870 j=j+6
871 WRITE(iugeo,'(1P1E12.5)')wap0(j)
872 j = j + 1
873 ELSE
874 WRITE(iugeo,'(2I10)')npt,isolnod
875 WRITE(iugeo,'(1P2E20.13)')(wap0(j-1+k),k=1,2)
876 j=j+2
877 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
878 j=j+6
879 WRITE(iugeo,'(1P1E20.13)')wap0(j)
880 j = j + 1
881 ENDIF
882C the test made consistent with respect to SMP
883c
884 ELSEIF (isolnod == 10) THEN
885 IF(icas_old /= 7) THEN
886 icas_old = 7
887 IF (outyy_fmt == 2) THEN
888 WRITE(iugeo,'(A)')
889 . '#FORMAT:(NPT,ISOLNOD,(2I8),I=1,NUMSOL'
890 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
891 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
892 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
893 ELSE
894 WRITE(iugeo,'(A)')
895 . '#FORMAT:(NPT,ISOLNOD,(2I10),I=1,NUMSOL'
896 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
897 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
898 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
899 ENDIF
900 ENDIF
901 IF (outyy_fmt == 2) THEN
902 WRITE(iugeo,'(2I8)')npt,isolnod
903C Writing on 2 lines for SMP compatibility
904 DO i = 1, npt
905 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
906 j = j + 6
907 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
908 j = j + 3
909 ENDDO
910 ELSE
911 WRITE(iugeo,'(2I10)')npt,isolnod
912C Writing on 2 lines for SMP compatibility
913 DO i = 1, npt
914 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
915 j = j + 6
916 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
917 j = j + 3
918 ENDDO
919 ENDIF
920 ELSE
921 IF (icas_old /= 8) THEN
922 icas_old = 8
923 IF (outyy_fmt == 2) THEN
924 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
925 . '#(NPT ),(3I8),I=1,NUMSOL'
926 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5/3E12.5) ',
927 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
928 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
929 ELSE
930 WRITE(iugeo,'(A)')'#FORMAT:(NPT,ISOLNOD, KHBE',
931 . '#(NPT ),(3I10),I=1,NUMSOL'
932 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13/3E20.13) ',
933 . '((TX(I,J),TY(I,J),TZ(I,J),TXY(I,J),TYZ(I,J),TZX(I,J),',
934 . '#EPSP(J,I),EINT(J,I),RHO(J,I),J=1,NPT),I=1,NUMSOL)'
935 ENDIF
936 ENDIF
937 IF (outyy_fmt == 2) THEN
938 WRITE(iugeo,'(3I8)') npt, isolnod, khbe
939C Writing on 2 lines for SMP compatibility
940 DO i = 1, npt
941 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
942 j = j + 6
943 WRITE(iugeo,'(1P3E12.5)')(wap0(j-1+k),k=1,3)
944 j = j + 3
945 ENDDO
946 ELSE
947 WRITE(iugeo,'(3I10)') npt, isolnod, khbe
948C Writing on 2 lines for SMP compatibility
949 DO i = 1, npt
950 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
951 j = j + 6
952 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
953 j = j + 3
954 ENDDO
955 ENDIF
956 ENDIF
957c-------------------------------
958c /STRAIN
959c-------------------------------
960 ELSEIF(itens == 3)THEN
961 npt = nint(wap0(j))
962 isolnod= nint(wap0(j+1))
963 nel = nint(wap0(j+2))
964 j=j+3
965 IF (icas_old /= 10) THEN
966 icas_old = 10
967 IF (outyy_fmt == 2) THEN
968 WRITE(iugeo,'(A)')
969 . '#FORMAT:(NPT, ISOLNOD, NUMSOL (3I8)'
970 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E12.5) ',
971 . '((EXX(I,J),EYY(I,J),EZZ(I,J),EXY(I,J),EYZ(I,J),EZX(I,J),',
972 . '#J=1,NPT),I=1,NUMSOL)'
973 ELSE
974 WRITE(iugeo,'(A)')
975 . '#FORMAT:(NPT, ISOLNOD, NUMSOL (3I10)'
976 WRITE(iugeo,'(2A)')'#FORMAT: (1P6E20.13) ',
977 . '((EXX(I,J),EYY(I,J),EZZ(I,J),EXY(I,J),EYZ(I,J),EZX(I,J),',
978 . '#J=1,NPT),I=1,NUMSOL)'
979 ENDIF
980 ENDIF
981c
982 IF(outyy_fmt == 2)THEN
983 WRITE(iugeo,'(3I8)') npt, isolnod,nel
984 DO i = 1,nel
985 DO ipt = 1, npt
986 WRITE(iugeo,'(1P6E12.5)')(wap0(j-1+k),k=1,6)
987 j = j + 6
988 ENDDO
989 ENDDO
990 ELSE
991 WRITE(iugeo,'(3I10)') npt,isolnod,nel
992 DO i=1,nel
993 DO ipt = 1, npt
994 WRITE(iugeo,'(1P6E20.13)')(wap0(j-1+k),k=1,6)
995 j = j + 6
996 ENDDO
997 ENDDO
998 ENDIF
999c
1000 ENDIF ! ITENS
1001c-------------------------------
1002 ENDDO ! WHILE (J < JJ_OLD)
1003 ENDIF ! jj_old>1
1004 ENDDO ! nn = 1, nspgroup
1005 ENDIF ! ispmd==0
1006C-----------
1007 RETURN