OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outp_r_t.F File Reference
#include "implicit_f.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_r_t (key, text, elbuf_tab, iparg, dd_iad, ixr, igeo, geo, sizloc, sizp0, siz_wr)
subroutine count_arsz_rt (iparg, igeo, geo, ixr, dd_iad, wasz, siz_write_loc)

Function/Subroutine Documentation

◆ count_arsz_rt()

subroutine count_arsz_rt ( integer, dimension(nparg,*) iparg,
integer, dimension(npropgi,*) igeo,
geo,
integer, dimension(nixr,*) ixr,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer, dimension(nspgroup+1) siz_write_loc )

Definition at line 481 of file outp_r_t.F.

482 use element_mod , only : nixr
483C-----------------------------------------------
484C I m p l i c i t T y p e s
485C-----------------------------------------------
486#include "implicit_f.inc"
487C-----------------------------------------------
488C C o m m o n B l o c k s
489C-----------------------------------------------
490#include "param_c.inc"
491#include "com01_c.inc"
492#include "task_c.inc"
493#include "scr16_c.inc"
494C-----------------------------------------------
495C D u m m y A r g u m e n t s
496C-----------------------------------------------
497 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,
498 . IXR(NIXR,*),IGEO(NPROPGI,*),SIZ_WRITE_LOC(NSPGROUP+1)
499 my_real
500 . geo(npropg,*)
501C-----------------------------------------------
502C L o c a l V a r i a b l e s
503C-----------------------------------------------
504 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,
505 . P0ARSZ2,WASZ2,IPROP,NUVAR,IGTYP,NFT,I
506C-----------------------------------------------
507 waszp = 0
508 wasz = 0
509 IF (outp_rs(2) == 1) THEN
510 ngf = 1
511 ngl = 0
512 DO nn=1,nspgroup
513 jj = 0
514 ngl = ngl + dd_iad(ispmd+1,nn)
515 DO ng = ngf,ngl
516 ity = iparg(5,ng)
517 nft = iparg(3,ng)
518 IF (ity == 6) THEN
519 nel = iparg(2,ng)
520 iprop = ixr(1,nft+1)
521 igtyp = igeo(11,iprop)
522 jj = jj + 3
523 IF (igtyp == 4) THEN
524 jj = jj + 7*nel
525 ELSEIF (igtyp == 12) THEN
526 jj = jj + 8*nel
527 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
528 . .OR. igtyp == 23 ) THEN
529 jj = jj + 40*nel
530 ELSEIF (igtyp == 26) THEN
531 jj = jj + 6*nel
532 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
533 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
534 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
535 . igtyp == 46) THEN
536 jj = jj + 13*nel
537!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
538!! JJ = JJ + 2 ! MOM1Y, MOM1Z
539!! ENDIF
540 nuvar = nint(geo(25,iprop))
541 jj = jj + nuvar*nel
542 ENDIF ! IF(IGTYP)
543 ENDIF ! IF (ITY)
544 ENDDO ! DO NG = NGF,NGL
545 ngf = ngl + 1
546 wasz = wasz + jj
547 siz_write_loc(nn) = jj
548 ENDDO ! DO NN=1,NSPGROUP
549 siz_write_loc(nspgroup+1) = wasz
550 ENDIF !
551C---
552 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ outp_r_t()

subroutine outp_r_t ( character*8 key,
character*40 text,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(nixr,*) ixr,
integer, dimension(npropgi,*) igeo,
geo,
integer sizloc,
integer sizp0,
integer siz_wr )

Definition at line 33 of file outp_r_t.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 use element_mod , only : nixr
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 "param_c.inc"
50#include "units_c.inc"
51#include "task_c.inc"
52#include "scr16_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 CHARACTER*8 KEY
57 CHARACTER*40 TEXT
58
59 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),
60 . IXR(NIXR,*),IGEO(NPROPGI,*),SIZLOC,SIZP0,SIZ_WR
61 my_real
62 . geo(npropg,*)
63C
64 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,J,JJ,ICAS_OLD,K
69 INTEGER NG, NEL, NFT, ITY,
70 . JJ_OLD, NGF, NGL, NN, LEN, NUVAR,
71 . LIAD, IUS, MLW2,NAD,
72 . MT,IPROP,IGTYP,COMPTEUR,L,II(6),IV
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)
77C
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79C-----------------------------------------------
80 IF (ispmd == 0) THEN
81 WRITE(iugeo,'(2A)')'/SPRING /',key
82 WRITE(iugeo,'(A)') text
83 ENDIF
84C
85 jj_old = 1
86 ngf = 1
87 ngl = 0
88 jj = 0
89 compteur = 0
90 DO nn=1,nspgroup
91 ngl = ngl + dd_iad(ispmd+1,nn)
92 DO ng=ngf,ngl
93 ity = iparg(5,ng)
94 nft = iparg(3,ng)
95 gbuf => elbuf_tab(ng)%GBUF
96C------------
97 IF (ity == 6) THEN
98 iprop = ixr(1,nft+1)
99 igtyp = igeo(11,iprop)
100 nel = iparg(2,ng)
101 nft = iparg(3,ng)
102C------------
103 IF (igtyp == 4) THEN
104 wa(jj + 1) = igtyp
105 wa(jj + 2) = nel
106 wa(jj + 3) = 0
107 jj = jj + 3
108 DO i=1,nel
109 wa(jj + 1) = gbuf%FOR(i)
110 wa(jj + 2) = gbuf%TOTDEPL(i)
111 wa(jj + 3) = gbuf%FOREP(i)
112 wa(jj + 4) = gbuf%DEP_IN_TENS(i)
113 wa(jj + 5) = gbuf%DEP_IN_COMP(i)
114 wa(jj + 6) = gbuf%LENGTH(i)
115 wa(jj + 7) = gbuf%EINT(i)
116 jj = jj + 7
117 ENDDO
118C------------
119 ELSEIF (igtyp == 12) THEN
120 wa(jj + 1) = igtyp
121 wa(jj + 2) = nel
122 wa(jj + 3) = 0
123 jj = jj + 3
124 DO i=1,nel
125 wa(jj + 1) = gbuf%FOR(i)
126 wa(jj + 2) = gbuf%TOTDEPL(i)
127 wa(jj + 3) = gbuf%FOREP(i)
128 wa(jj + 4) = gbuf%DEP_IN_TENS(i)
129 wa(jj + 5) = gbuf%DEP_IN_COMP(i)
130 wa(jj + 6) = gbuf%LENGTH(i)
131 wa(jj + 7) = gbuf%EINT(i)
132 wa(jj + 8) = gbuf%DFS(i)
133 jj = jj + 8
134 ENDDO
135C------------
136 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
137 . .OR. igtyp == 23) THEN
138 wa(jj + 1) = igtyp
139 wa(jj + 2) = nel
140 wa(jj + 3) = 0
141 jj = jj + 3
142 DO j=1,6
143 ii(j) = (j-1)*nel + 1
144 ENDDO
145 DO i=1,nel
146 DO j=1,3
147 wa(jj + (j-1)*5 + 1) = gbuf%FOR(ii(j) + i - 1)
148 wa(jj + (j-1)*5 + 2) = gbuf%TOTDEPL(ii(j) + i - 1)
149 wa(jj + (j-1)*5 + 3) = gbuf%FOREP(ii(j) + i - 1)
150 wa(jj + (j-1)*5 + 4) = gbuf%DEP_IN_TENS(ii(j) + i - 1)
151 wa(jj + (j-1)*5 + 5) = gbuf%DEP_IN_COMP(ii(j) + i - 1)
152 wa(jj + (j-1)*5 + 16)= gbuf%MOM(ii(j) + i - 1)
153 wa(jj + (j-1)*5 + 17)= gbuf%TOTROT(ii(j) + i - 1)
154 wa(jj + (j-1)*5 + 18)= gbuf%MOMEP(ii(j) + i - 1)
155 wa(jj + (j-1)*5 + 19)= gbuf%ROT_IN_TENS(ii(j) + i - 1)
156 wa(jj + (j-1)*5 + 20)= gbuf%ROT_IN_COMP(ii(j) + i - 1)
157 wa(jj + j + 30) = gbuf%LENGTH(ii(j) + i - 1)
158 ENDDO
159 wa(jj + 34) = gbuf%EINT(i)
160c
161 DO j=1,6
162 wa(jj + j + 34) = gbuf%E6(ii(j) + i - 1) ! E6(1:6)
163 ENDDO
164 jj = jj + 40
165c
166 ENDDO
167C------------
168 ELSEIF (igtyp == 26) THEN
169 wa(jj + 1) = igtyp
170 wa(jj + 2) = nel
171 wa(jj + 3) = 0
172 jj = jj + 3
173 DO i=1,nel
174 wa(jj + 1) = gbuf%FOR(i)
175 wa(jj + 2) = gbuf%TOTDEPL(i)
176 wa(jj + 3) = gbuf%FOREP(i)
177 wa(jj + 4) = gbuf%LENGTH(i)
178 wa(jj + 5) = gbuf%EINT(i)
179 wa(jj + 6) = gbuf%DV(i)
180 jj = jj + 6
181 ENDDO
182C------------
183 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
184 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
185 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
186 . igtyp == 46) THEN
187 nuvar = nint(geo(25,iprop))
188 wa(jj +1) = igtyp
189 wa(jj +2) = nel
190 wa(jj +3) = nuvar
191 jj = jj + 3
192 DO i=1,nel
193 DO j=1,3
194 ii(j) = (j-1)*nel + 1
195 wa(jj + (j-1)*2 + 1) = gbuf%FOR(ii(j) + i - 1)
196 wa(jj + (j-1)*2 + 2) = gbuf%V_REPCVT(ii(j) + i - 1)
197 wa(jj + (j-1)*2 + 7) = gbuf%MOM(ii(j) + i - 1)
198 wa(jj + (j-1)*2 + 8) = gbuf%VR_REPCVT(ii(j) + i - 1)
199 ENDDO
200 wa(jj + 13) = gbuf%EINT(i)
201 jj = jj + 13
202c
203!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
204!! WA(JJ + 1) = GBUF%MOM(II(4) + I - 1)
205!! WA(JJ + 2) = GBUF%MOM(II(5) + I - 1)
206!! JJ = JJ + 2
207!! ENDIF
208c
209 DO j=1,nuvar
210 iv = nuvar*(i-1) + j
211 wa(jj + j) = gbuf%VAR(iv)
212 ENDDO
213 jj = jj + nuvar
214 ENDDO ! DO I=1,NEL
215 ENDIF ! IF (IGTYP)
216C------------
217 ENDIF ! IF (ITY)
218 ENDDO ! DO NG=NGF,NGL
219 ngf = ngl + 1
220 jj_loc(nn) = jj - compteur ! size of each group
221 compteur = jj
222 ENDDO ! DO NN=1,NSPGROUP ! nn=1,nspdgroup
223!---
224! ++++++++++
225!---
226 IF (nspmd > 1) THEN
227 CALL spmd_rgather9_1comm(wa,jj,jj_loc,wap0_loc,sizp0,adress)
228 ELSE
229 wap0_loc(1:jj) = wa(1:jj)
230 adress(1,1) = 1
231 DO nn = 2,nspgroup+1
232 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
233 ENDDO
234 ENDIF
235!---
236! ++++++++++
237!---
238 IF (ispmd == 0) THEN
239 DO nn=1,nspgroup
240 compteur = 0
241 DO k = 1,nspmd
242 IF ((adress(nn+1,k)-1-adress(nn,k)) > =0) THEN
243 DO l = adress(nn,k),adress(nn+1,k)-1
244 compteur = compteur + 1
245 wap0(compteur) = wap0_loc(l)
246 ENDDO ! l=... , ...
247 ENDIF !if(size_loc>0)
248 ENDDO ! k=1,nspmd
249C
250 jj_old = compteur
251 IF (jj_old > 0) THEN
252 icas_old = 0
253 j = 1
254 DO WHILE (j < jj_old+1)
255 igtyp = nint(wap0(j))
256 nel = nint(wap0(j+1))
257 nuvar = nint(wap0(j+2))
258 j = j + 3
259C--------------------------------------
260 IF (igtyp == 4) THEN
261C--------------------------------------
262 IF (icas_old /= 1) THEN
263 icas_old = 1
264
265 IF (outyy_fmt == 2) THEN
266 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=1,NEL)'
267 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(XLO(I),EI(I),I=1,NEL)'
268 ELSE
269 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=1,NEL)'
270 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(XLO(I),EI(I),I=1,NEL)'
271 ENDIF
272 ENDIF ! IF (ICAS_OLD /= 1)
273 IF (outyy_fmt == 2) THEN
274 WRITE(iugeo,'(2I8)')igtyp,nel
275 ELSE
276 WRITE(iugeo,'(2I10)')igtyp,nel
277 ENDIF
278 DO i=1,nel
279 IF (outyy_fmt == 2) THEN
280!! WRITE(IUGEO,'(1P5E12.5)') (WAP0(J-1+K),K=1,7)
281 WRITE(iugeo,'(1P5E12.5)') (wap0(j-1+k),k=1,5)
282 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=6,7)
283 ELSE
284!! WRITE(IUGEO,'(1P5E20.13)')(WAP0(J-1+K),K=1,7)
285 WRITE(iugeo,'(1P5E20.13)')(wap0(j-1+k),k=1,5)
286 WRITE(iugeo,'(1P2E20.13)')(wap0(j-1+k),k=6,7)
287 ENDIF
288 j = j + 7
289 ENDDO ! DO I=1,NEL
290C--------------------------------------
291 ELSEIF (igtyp == 12) THEN
292C--------------------------------------
293 IF (icas_old /= 2) THEN
294 icas_old = 2
295 IF (outyy_fmt == 2) THEN
296 WRITE(iugeo,'(A)') '#FORMAT:(1P5E12.5) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=1,NEL)'
297 WRITE(iugeo,'(A)') '#FORMAT:(1P3E12.5) #(XL0(I),EI(I),DFS(I),I=1,NEL)'
298 ELSE
299 WRITE(iugeo,'(A)') '#FORMAT:(1P5E20.13) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=1,NEL)'
300 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(XL0(I),EI(I),DFS(I),I=1,NEL)'
301 ENDIF ! IF (OUTYY_FMT == 2)
302 ENDIF ! IF (ICAS_OLD /= 2)
303 IF (outyy_fmt == 2) THEN
304 WRITE(iugeo,'(2I8)')igtyp,nel
305 ELSE
306 WRITE(iugeo,'(2I10)')igtyp,nel
307 ENDIF
308 DO i=1,nel
309 IF (outyy_fmt == 2) THEN
310!! WRITE(IUGEO,'(1P5E12.5)') (WAP0(J-1+K),K=1,8)
311 WRITE(iugeo,'(1P5E12.5)') (wap0(j-1+k),k=1,5)
312 WRITE(iugeo,'(1P3E12.5)') (wap0(j-1+k),k=6,8)
313 ELSE
314!! WRITE(IUGEO,'(1P5E20.13)')(WAP0(J-1+K),K=1,8)
315 WRITE(iugeo,'(1P5E20.13)')(wap0(j-1+k),k=1,5)
316 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=6,8)
317 ENDIF
318 j = j + 8
319 ENDDO ! DO I=1,NEL
320C--------------------------------------
321 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
322 . .OR. igtyp == 23 ) THEN
323C--------------------------------------
324 IF (icas_old /= 3) THEN
325 icas_old = 3
326 IF (outyy_fmt == 2) THEN
327 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(FX(I),DX(I),FXEP(I),DPX(I),DPX2(I),I=1,NEL)'
328 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(FY(I),DY(I),FYEP(I),DPY(I),DPY2(I),I=1,NEL)'
329 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(FZ(I),DZ(I),FZEP(I),DPZ(I),DPZ2(I),I=1,NEL)'
330 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(XMOM(I),RX(I),XMEP(I),RPX(I),RPX2(I),I=1,NEL)'
331 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(YMOM(I),RY(I),YMEP(I),RPY(I),RPY2(I),I=1,NEL)'
332 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(ZMOM(I),RZ(I),ZMEP(I),RPZ(I),RPZ2(I),I=1,NEL)'
333 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(XLO(I),YL0(I),ZL0(I),EI(I),E1(I),I=1,NEL)'
334 WRITE(iugeo,'(2A)')'#FORMAT:(1P5E12.5) #(E2(I),E3(I),E4(I),E5(I),E6(I),I=1,NEL)'
335 ELSE
336 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FX(I),DX(I),FXEP(I),DPX(I),DPX2(I),I=1,NEL)'
337 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FY(I),DY(I),FYEP(I),DPY(I),DPY2(I),I=1,NEL)'
338 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FZ(I),DZ(I),FZEP(I),DPZ(I),DPZ2(I),I=1,NEL)'
339 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(XMOM(I),RX(I),XMEP(I),RPX(I),RPX2(I),I=1,NEL)'
340 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(YMOM(I),RY(I),YMEP(I),RPY(I),RPY2(I),I=1,NEL)'
341 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(ZMOM(I),RZ(I),ZMEP(I),RPZ(I),RPZ2(I),I=1,NEL)'
342 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(XLO(I),YL0(I),ZL0(I),EI(I),E1(I),I=1,NEL)'
343 WRITE(iugeo,'(2A)')'#FORMAT:(1P5E20.13) #(E2(I),E3(I),E4(I),E5(I),E6(I),I=1,NEL)'
344 ENDIF ! IF (OUTYY_FMT == 2)
345 ENDIF ! IF (ICAS_OLD /= 3)
346 IF (outyy_fmt == 2) THEN
347 WRITE(iugeo,'(2I8)')igtyp,nel
348 ELSE
349 WRITE(iugeo,'(2I10)')igtyp,nel
350 ENDIF
351 DO i=1,nel
352 IF (outyy_fmt == 2) THEN
353 WRITE(iugeo,'(1P5E12.5)') (wap0(j-1+k),k=1,40)
354 ELSE
355 WRITE(iugeo,'(1P5E20.13)')(wap0(j-1+k),k=1,40)
356 ENDIF
357 j = j + 40
358 ENDDO ! DO I=1,NEL
359C--------------------------------------
360 ELSEIF (igtyp == 26) THEN
361C--------------------------------------
362 IF (icas_old /= 2) THEN
363 icas_old = 2
364 IF (outyy_fmt == 2) THEN
365 WRITE(iugeo,'(A)') '#FORMAT:(1P3E12.5) #(F(I),DL(I),FEP(I),I=1,NEL)'
366 WRITE(iugeo,'(A)') '#FORMAT:(1P3E12.5) #(XL0(I),EI(I),DV(I),I=1,NEL)'
367 ELSE
368 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(F(I),DL(I),FEP(I),I=1,NEL)'
369 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(XL0(I),EI(I),DV(I),I=1,NEL)'
370 ENDIF ! IF (OUTYY_FMT == 2)
371 ENDIF ! IF (ICAS_OLD /= 2)
372 IF (outyy_fmt == 2) THEN
373 WRITE(iugeo,'(2I8)') igtyp,nel
374 ELSE
375 WRITE(iugeo,'(2I10)')igtyp,nel
376 ENDIF
377 DO i=1,nel
378 IF (outyy_fmt == 2) THEN
379 WRITE(iugeo,'(1P3E12.5)') (wap0(j-1+k),k=1,3)
380 WRITE(iugeo,'(1P3E12.5)') (wap0(j-1+k),k=4,6)
381 ELSE
382 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=1,3)
383 WRITE(iugeo,'(1P3E20.13)')(wap0(j-1+k),k=4,6)
384 ENDIF
385 j = j + 6
386 ENDDO ! DO I=1,NEL
387C--------------------------------------
388 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
389 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
390 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
391 . igtyp == 46) THEN
392C--------------------------------------
393 IF (icas_old /= 4) THEN
394 icas_old = 4
395 IF (outyy_fmt == 2) THEN
396 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(FX(I),DX(I),I=1,NEL)'
397 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(FY(I),DY(I),I=1,NEL)'
398 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(FZ(I),DZ(I),I=1,NEL)'
399 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(XMOM(I),RX(I),I=1,NEL)'
400 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(YMOM(I),RY(I),I=1,NEL)'
401 WRITE(iugeo,'(A)')'#FORMAT:(1P2E12.5) #(ZMOM(I),RZ(I),I=1,NEL)'
402 WRITE(iugeo,'(A)')'#FORMAT:(1P1E12.5) #(EI(I),I=1,NEL)'
403!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
404!! WRITE(IUGEO,'(A)')'#FORMAT:(1P2E12.5)
405!! . #(MOM1Y(I),MOM1Z(I),I=1,NEL)'
406!! ENDIF
407 WRITE(iugeo,'(A)')'#FORMAT:(1P5E12.5) #(UVAR(I,J),J=1,NUVAR),I=1,NEL)'
408 ELSE
409 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FX(I),DX(I),I=1,NEL)'
410 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FY(I),DY(I),I=1,NEL)'
411 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FZ(I),DZ(I),I=1,NEL)'
412 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(XMOM(I),RX(I),I=1,NEL)'
413 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(YMOM(I),RY(I),I=1,NEL)'
414 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(ZMOM(I),RZ(I),I=1,NEL)'
415 WRITE(iugeo,'(A)')'#FORMAT:(1P1E20.13) #(EI(I),I=1,NEL)'
416!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
417!! WRITE(IUGEO,'(A)')'#FORMAT:(1P2E20.13)
418!! . #(MOM1Y(I),MOM1Z(I),I=1,NEL)'
419!! ENDIF
420 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(UVAR(I,J),J=1,NUVAR),I=1,NEL)'
421 ENDIF ! IF (OUTYY_FMT == 2)
422 ENDIF ! IF (ICAS_OLD /= 4)
423 IF (outyy_fmt == 2) THEN
424 WRITE(iugeo,'(3I8)') igtyp,nel,nuvar
425 ELSE
426 WRITE(iugeo,'(3I10)')igtyp,nel,nuvar
427 ENDIF
428 DO i=1,nel
429 IF (outyy_fmt == 2) THEN
430!! WRITE(IUGEO,'(1P5E12.5)') (WAP0(J-1+K),K=1,12)
431 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=1,2)
432 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=3,4)
433 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=5,6)
434 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=7,8)
435 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=9,10)
436 WRITE(iugeo,'(1P2E12.5)') (wap0(j-1+k),k=11,12)
437 WRITE(iugeo,'(1P1E12.5)') wap0(j-1+13) ! EINT
438 ELSE
439!! WRITE(IUGEO,'(1P5E20.13)') (WAP0(J-1+K),K=1,12)
440 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=1,2)
441 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=3,4)
442 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=5,6)
443 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=7,8)
444 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=9,10)
445 WRITE(iugeo,'(1P2E20.13)') (wap0(j-1+k),k=11,12)
446 WRITE(iugeo,'(1P1E20.13)') wap0(j-1+13) ! EINT
447 ENDIF
448 j = j + 13
449c
450!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
451!! IF (OUTYY_FMT == 2) THEN
452!! WRITE(IUGEO,'(1P2E12.5)') (WAP0(J-1+K),K=1,2)
453!! ELSE
454!! WRITE(IUGEO,'(1P2E20.13)') (WAP0(J-1+K),K=1,2) ! MOM1Y, MOM1Z
455!! ENDIF
456!! ENDIF
457c
458 IF (outyy_fmt == 2) THEN
459 WRITE(iugeo,'(1P5E12.5)') (wap0(j-1+k),k=1,nuvar)
460 ELSE
461 WRITE(iugeo,'(1P5E20.13)')(wap0(j-1+k),k=1,nuvar)
462 ENDIF
463 j = j + nuvar
464 ENDDO ! DO I=1,NEL
465 ENDIF ! igtyp
466 ENDDO ! do while
467 ENDIF ! jj_old>0
468 ENDDO ! nn = 1, nspgroup
469 ENDIF ! ispmd=0
470C---
471 RETURN
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1181