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 477 of file outp_r_t.F.

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

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