OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dparrws.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!|| dparrws ../engine/source/output/anim/generate/dparrws.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_gather_wa ../engine/source/mpi/anim/spmd_gather_wa.F
29!|| write_i_c ../common_source/tools/input_output/write_routines.c
30!||--- uses -----------------------------------------------------
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!||====================================================================
33 SUBROUTINE dparrws(NESBW,NSTRF,IXC ,
34 2 IXTG ,X ,NODCUT,RWBUF,NPRW,
35 3 NODGLOB,BUF,IXS )
36 use element_mod , only : nixs,nixc,nixtg
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "spmd_c.inc"
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48#include "task_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NESBW,NSTRF(*),IXC(NIXC,*),IXTG(NIXTG,*),
53 . NODCUT,NPRW(*), IXS(NIXS,*),BUF,NODGLOB(*)
54 my_real
55 . x(3,*),rwbuf(nrwlp,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER J, JJ, LEN, I, K, L, KK, K0, K5, K9, N,
60 . N0, N1, N2, N3, N4, N10, NSEG, NSEGC, NSEGTG, ITYP,
61 . unpack(15,4), ii(8), n5, n6, n7, n8, nsegs, k3,ow,
62 . wa(6*buf+4)
63 my_real
64 . xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
65 . xx4, yy4, zz4, d13, xxc, yyc, zzc
66 INTEGER POWER2(8),IPACK
67 INTEGER :: INDICE
68 INTEGER :: MODE,SIZE_BUFFER_S,SIZE_BUFFER00_R
69 INTEGER, DIMENSION(NSPMD) :: SHIFT_R,NB_ELEM_R
70 INTEGER, DIMENSION(NSECT,3,NSPMD) :: SHIFT_SECT
71 INTEGER, DIMENSION(NSECT+1,3) ::SINDEX
72 INTEGER, DIMENSION(NSECT+1,3,NSPMD) :: RINDEX_PROC
73 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFFER_S
74 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFFER00_R
75
76 DATA power2/1,2,4,8,16,32,64,128/
77C-----------------------------------------------
78 DATA unpack/1,2,1,3,1,2,1,4,1,2,1,3,1,2,1,
79 . 0,0,2,0,3,3,2,0,4,4,2,4,3,3,2,
80 . 0,0,0,0,0,0,3,0,0,0,4,0,4,4,3,
81 . 0,0,0,0,0,0,0,0,0,0,0,0,0,0,4/
82
83! 1st step : count the number of value send by each proc
84! 2nd step : allocate the sended buffer for each proc and the received buffer (proc = 0)
85! 3rd step : initialize and send the sended buffer to proc 0
86! 4th step : write the data (proc=0)
87!
88!
89! Structure of the buffer :
90! *******************
91!
92! sended buffer (local on each proc) :
93! sh = shell ; t = shell3n ; s = solid
94!
95!
96! sh | t | s | sh | t | s | sh | t | s | sh | t | s | sh | t | s | sh | t | s | sh | t | s | sh | t | s | ...
97! \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ ...
98! nsect = 1 2 3 4 ...
99!
100!
101!
102!
103! received buffer (only on proc 0) :
104!
105! sh | t | s | sh | t | s |... sh | t | s | sh | t | s | sh | t | s |... sh | t | s | ... sh | t | s | sh | t | s | ...
106! \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ ...\__________/ \__________/ ...
107! nsect = 1 2 ... n || 1 2 ... n | || 1 2 ...
108! ||________________________________________||________________________________________| ...||_____________________________
109! | | |
110! proc = 0 1 ... m
111
112! Index arrays : SHIFT_R, SHIFT_SECT, RINDEX_PROC
113! SHIFT_R --> index for the processor
114! SHIFT_SECT --> index for the section for each processor
115! RINDEX_PROC --> index for the element types (shell, shell3n or solid) for each processor and each section
116!
117!
118
119! SHIFT_R(1) SHIFT_R(2) SHIFT_R(m+1)
120!
121! ||________________________________________||________________________________________| ...||_____________________________
122! | | |
123! proc = 0 1 ... m
124
125! SHIFT_SECT :
126! (1,1) (2,1) (n,1) (1,2) ...
127! \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ ...\__________/ \__________/ ...
128! nsect = 1 2 ... n || 1 2 ... n | || 1 2 ...
129!
130! RINDEX_PROC
131! (1) (2) (3)
132! sh | t | s |
133!
134!
135! -----------------------------------------------
136
137! ----------------------
138! count the number of data
139! ----------------------
140 sindex(1:nsect+1,1:3) = 0
141 size_buffer00_r = 0
142 IF(ispmd==0) rindex_proc(1:nsect,1:3,1:nspmd) = 0
143 jj = 0
144
145 IF (nsect>0) THEN
146 k0 = nstrf(25)
147 DO i=1,nsect
148 n0 = numnod + nodcut + i - 1
149 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
150 1 + 2*nstrf(k0+7) +nstrf(k0+8)*2
151 nsegc = nstrf(k0+9)
152
153! ----------------
154! SHELL
155! ----------------
156 DO j=1,nsegc
157 kk = k5+2*(j-1)
158 n = nstrf(kk)
159 IF(nstrf(kk+1)/=0) THEN
160 jj = jj + 4
161 ENDIF
162 ENDDO
163 sindex(i,1) = jj
164 k9 = k5+2*nstrf(k0+9) +2*nstrf(k0+10)
165 1 +2*nstrf(k0+11)+2*nstrf(k0+12)
166 nsegtg = nstrf(k0+13)
167! ----------------
168! SHELL3N
169! ----------------
170 DO j=1,nsegtg
171 kk = k9+2*(j-1)
172 n = nstrf(kk)
173 IF(nstrf(kk+1)/=0) THEN
174 jj = jj + 4
175 ENDIF
176 ENDDO
177 sindex(i,2) = jj
178
179 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
180 nsegs=nstrf(k0+7)
181
182! ----------------
183! SOLID
184! ----------------
185 IF(nsegs/=0)THEN
186 jj = jj + 4
187 END IF
188 DO j=1,nsegs
189 kk=k3+2*(j-1)
190 ipack=nstrf(kk+1)
191 IF(ipack/=0)THEN
192 n =nstrf(kk)
193 IF (nspmd == 1) THEN
194 ii(1)=ixs(2,n)-1
195 ii(2)=ixs(3,n)-1
196 ii(3)=ixs(4,n)-1
197 ii(4)=ixs(5,n)-1
198 ii(5)=ixs(6,n)-1
199 ii(6)=ixs(7,n)-1
200 ii(7)=ixs(8,n)-1
201 ii(8)=ixs(9,n)-1
202 ELSE
203 ii(1)=nodglob(ixs(2,n))-1
204 ii(2)=nodglob(ixs(3,n))-1
205 ii(3)=nodglob(ixs(4,n))-1
206 ii(4)=nodglob(ixs(5,n))-1
207 ii(5)=nodglob(ixs(6,n))-1
208 ii(6)=nodglob(ixs(7,n))-1
209 ii(7)=nodglob(ixs(8,n))-1
210 ii(8)=nodglob(ixs(9,n))-1
211 ENDIF
212
213 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
214 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
215C tetra4, tetra10
216 n1=mod(ipack/power2(1),2)
217 n2=mod(ipack/power2(3),2)
218 n3=mod(ipack/power2(5),2)
219 n4=mod(ipack/power2(6),2)
220 IF(n1/=0.AND.n2/=0.AND.n3/=0)THEN
221 jj=jj+4
222 END IF
223 IF(n1/=0.AND.n2/=0.AND.n4/=0)THEN
224 jj=jj+4
225 END IF
226 IF(n2/=0.AND.n3/=0.AND.n4/=0)THEN
227 jj=jj+4
228 END IF
229 IF(n3/=0.AND.n1/=0.AND.n4/=0)THEN
230 jj=jj+4
231 END IF
232 ELSE
233C brick, shell16, brick20
234 n1=mod(ipack/power2(1),2)
235 n2=mod(ipack/power2(2),2)
236 n3=mod(ipack/power2(3),2)
237 n4=mod(ipack/power2(4),2)
238 n5=mod(ipack/power2(5),2)
239 n6=mod(ipack/power2(6),2)
240 n7=mod(ipack/power2(7),2)
241 n8=mod(ipack/power2(8),2)
242 IF(n1/=0.AND.n2/=0.AND.n3/=0.AND.n4/=0)THEN
243 jj=jj+4
244 END IF
245 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8/=0)THEN
246 jj=jj+4
247 END IF
248 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)THEN
249 jj=jj+4
250 END IF
251 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)THEN
252 jj=jj+4
253 END IF
254 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)THEN
255 jj=jj+4
256 END IF
257 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)THEN
258 jj=jj+4
259 END IF
260 END IF
261 END IF
262 END DO
263 k0=nstrf(k0+24)
264 sindex(i,3) = jj
265 ENDDO
266
267 size_buffer_s = jj
268 sindex(nsect+1,1:3) = size_buffer_s
269! -----------------------------------------------
270! ----------------------
271! Allocate the sended buffer
272! ----------------------
273 ALLOCATE( buffer_s(size_buffer_s) )
274 mode = 0
275
276 ALLOCATE( buffer00_r(0) )
277
278 IF(nspmd>1) THEN
279 CALL spmd_gather_wa(mode,size_buffer_s,size_buffer00_r,sindex,rindex_proc,
280 1 buffer_s,buffer00_r,shift_r,nb_elem_r)
281 ELSE
282 size_buffer00_r = size_buffer_s
283 ! shift for the _gatherv comm
284 shift_r(1) = 0
285 rindex_proc(1:nsect,1:3,1) = sindex(1:nsect,1:3)
286 ENDIF
287
288 IF(ispmd==0) THEN
289 DEALLOCATE( buffer00_r )
290 ALLOCATE( buffer00_r(size_buffer00_r) )
291 ENDIF
292
293! ----------------------
294! initialize the sended buffer
295! ----------------------
296 k0 = nstrf(25)
297 jj = 0
298 DO i=1,nsect
299 n0 = numnod + nodcut + i - 1
300 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
301 1 + 2*nstrf(k0+7) +nstrf(k0+8)*2
302 nsegc = nstrf(k0+9)
303
304 DO j=1,nsegc
305 kk = k5+2*(j-1)
306 n = nstrf(kk)
307 IF(nstrf(kk+1)/=0) THEN
308 n1 = unpack(nstrf(kk+1),1)
309 n2 = unpack(nstrf(kk+1),2)
310 IF(n2==0)THEN
311 n2 = n1
312 n3 = n1
313 ELSE
314 n3 = unpack(nstrf(kk+1),3)
315 IF(n3==0)n3 = n2
316 ENDIF
317 IF (nspmd == 1) THEN
318 buffer_s(jj+1) = n0
319 buffer_s(jj+2) = ixc(1+n1,n)-1
320 buffer_s(jj+3) = ixc(1+n2,n)-1
321 buffer_s(jj+4) = ixc(1+n3,n)-1
322 jj = jj + 4
323 ELSE
324 buffer_s(jj+1) = numnodg + nodcut + i - 1
325 buffer_s(jj+2) = nodglob(ixc(1+n1,n))-1
326 buffer_s(jj+3) = nodglob(ixc(1+n2,n))-1
327 buffer_s(jj+4) = nodglob(ixc(1+n3,n))-1
328 jj = jj + 4
329 ENDIF
330 ENDIF
331 ENDDO
332
333 k9=k5+2*nstrf(k0+9) +2*nstrf(k0+10)
334 1 + 2*nstrf(k0+11)+2*nstrf(k0+12)
335 nsegtg = nstrf(k0+13)
336 DO j=1,nsegtg
337 kk = k9+2*(j-1)
338 n = nstrf(kk)
339 IF(nstrf(kk+1)/=0) THEN
340 n1 = unpack(nstrf(1+kk),1)
341 n2 = unpack(nstrf(1+kk),2)
342 IF(n2==0)THEN
343 n2 = n1
344 n3 = n1
345 ELSE
346 n3 = unpack(nstrf(1+kk),3)
347 IF(n3==0)n3 = n2
348 ENDIF
349 IF (nspmd == 1) THEN
350 buffer_s(jj+1) = n0
351 buffer_s(jj+2) = ixtg(1+n1,n)-1
352 buffer_s(jj+3) = ixtg(1+n2,n)-1
353 buffer_s(jj+4) = ixtg(1+n3,n)-1
354 jj = jj + 4
355 ELSE
356 buffer_s(jj+1) = numnodg + nodcut + i - 1
357 buffer_s(jj+2) = nodglob(ixtg(1+n1,n))-1
358 buffer_s(jj+3) = nodglob(ixtg(1+n2,n))-1
359 buffer_s(jj+4) = nodglob(ixtg(1+n3,n))-1
360 jj = jj + 4
361 ENDIF
362 ENDIF
363 ENDDO
364
365 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
366 nsegs=nstrf(k0+7)
367
368 IF(nsegs/=0)THEN
369 IF (nspmd == 1) THEN
370 buffer_s(jj+1) = n0
371 buffer_s(jj+2) = n0
372 buffer_s(jj+3) = n0
373 buffer_s(jj+4) = n0
374 jj = jj + 4
375 ELSE
376 buffer_s(jj+1) = numnodg + nodcut + i - 1
377 buffer_s(jj+2) = numnodg + nodcut + i - 1
378 buffer_s(jj+3) = numnodg + nodcut + i - 1
379 buffer_s(jj+4) = numnodg + nodcut + i - 1
380 jj = jj + 4
381 ENDIF
382 END IF
383C
384 DO j=1,nsegs
385 kk=k3+2*(j-1)
386 ipack=nstrf(kk+1)
387 IF(ipack/=0)THEN
388 n =nstrf(kk)
389 IF (nspmd == 1) THEN
390 ii(1)=ixs(2,n)-1
391 ii(2)=ixs(3,n)-1
392 ii(3)=ixs(4,n)-1
393 ii(4)=ixs(5,n)-1
394 ii(5)=ixs(6,n)-1
395 ii(6)=ixs(7,n)-1
396 ii(7)=ixs(8,n)-1
397 ii(8)=ixs(9,n)-1
398 ELSE
399 ii(1)=nodglob(ixs(2,n))-1
400 ii(2)=nodglob(ixs(3,n))-1
401 ii(3)=nodglob(ixs(4,n))-1
402 ii(4)=nodglob(ixs(5,n))-1
403 ii(5)=nodglob(ixs(6,n))-1
404 ii(6)=nodglob(ixs(7,n))-1
405 ii(7)=nodglob(ixs(8,n))-1
406 ii(8)=nodglob(ixs(9,n))-1
407 ENDIF
408
409 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
410 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
411C tetra4, tetra10
412 n1=mod(ipack/power2(1),2)
413 n2=mod(ipack/power2(3),2)
414 n3=mod(ipack/power2(5),2)
415 n4=mod(ipack/power2(6),2)
416 IF(n1/=0.AND.n2/=0.AND.n3/=0)THEN
417 buffer_s(jj+1) =ii(1)
418 buffer_s(jj+2) =ii(3)
419 buffer_s(jj+3) =ii(5)
420 buffer_s(jj+4) =ii(5)
421 jj=jj+4
422 END IF
423 IF(n1/=0.AND.n2/=0.AND.n4/=0)THEN
424 buffer_s(jj+1) =ii(1)
425 buffer_s(jj+2) =ii(3)
426 buffer_s(jj+3) =ii(6)
427 buffer_s(jj+4) =ii(6)
428 jj=jj+4
429 END IF
430 IF(n2/=0.AND.n3/=0.AND.n4/=0)THEN
431 buffer_s(jj+1) =ii(3)
432 buffer_s(jj+2) =ii(5)
433 buffer_s(jj+3) =ii(6)
434 buffer_s(jj+4) =ii(6)
435 jj=jj+4
436 END IF
437 IF(n3/=0.AND.n1/=0.AND.n4/=0)THEN
438 buffer_s(jj+1) =ii(5)
439 buffer_s(jj+2) =ii(1)
440 buffer_s(jj+3) =ii(6)
441 buffer_s(jj+4) =ii(6)
442 jj=jj+4
443 END IF
444 ELSE
445C brick, shell16, brick20
446 n1=mod(ipack/power2(1),2)
447 n2=mod(ipack/power2(2),2)
448 n3=mod(ipack/power2(3),2)
449 n4=mod(ipack/power2(4),2)
450 n5=mod(ipack/power2(5),2)
451 n6=mod(ipack/power2(6),2)
452 n7=mod(ipack/power2(7),2)
453 n8=mod(ipack/power2(8),2)
454
455 IF(n1/=0.AND.n2/=0.AND.n3/=0.AND.n4/=0)THEN
456 buffer_s(jj+1) =ii(1)
457 buffer_s(jj+2) =ii(2)
458 buffer_s(jj+3) =ii(3)
459 buffer_s(jj+4) =ii(4)
460 jj=jj+4
461 END IF
462 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8/=0)THEN
463 buffer_s(jj+1) =ii(5)
464 buffer_s(jj+2) =ii(6)
465 buffer_s(jj+3) =ii(7)
466 buffer_s(jj+4) =ii(8)
467 jj=jj+4
468 END IF
469 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)THEN
470 buffer_s(jj+1) =ii(1)
471 buffer_s(jj+2) =ii(5)
472 buffer_s(jj+3) =ii(6)
473 buffer_s(jj+4) =ii(2)
474 jj=jj+4
475 END IF
476 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)THEN
477 buffer_s(jj+1) =ii(4)
478 buffer_s(jj+2) =ii(8)
479 buffer_s(jj+3) =ii(7)
480 buffer_s(jj+4) =ii(3)
481 jj=jj+4
482 END IF
483 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)THEN
484 buffer_s(jj+1) =ii(1)
485 buffer_s(jj+2) =ii(4)
486 buffer_s(jj+3) =ii(8)
487 buffer_s(jj+4) =ii(5)
488 jj=jj+4
489 END IF
490 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)THEN
491 buffer_s(jj+1) =ii(2)
492 buffer_s(jj+2) =ii(3)
493 buffer_s(jj+3) =ii(7)
494 buffer_s(jj+4) =ii(6)
495 jj=jj+4
496 END IF
497 END IF
498 END IF
499 END DO
500 k0=nstrf(k0+24)
501 ENDDO
502
503! ----------------------
504! send buffer
505! ----------------------
506
507 mode = 1
508 IF(nspmd>1) THEN
509 CALL spmd_gather_wa(mode,size_buffer_s,size_buffer00_r,sindex,rindex_proc,
510 1 buffer_s,buffer00_r,shift_r,nb_elem_r)
511 ELSE
512 buffer00_r(1:size_buffer00_r) = buffer_s(1:size_buffer_s)
513 ENDIF
514 DEALLOCATE( buffer_s )
515 ENDIF
516
517! ----------------------
518! write the received buffer
519! ----------------------
520
521
522
523! received buffer (only on proc 0) :
524!
525! sh | t | s | sh | t | s |... sh | t | s | sh | t | s | sh | t | s |... sh | t | s | ... sh | t | s | sh | t | s | ...
526! \__________/ \__________/ \__________/ \__________/ \__________/ \__________/ ...\__________/ \__________/ ...
527! nsect = 1 2 ... n || 1 2 ... n | || 1 2 ...
528! ||________________________________________||________________________________________| ...||_____________________________
529! | | |
530! proc = 0 1 ... m
531
532
533 IF (ispmd==0.AND.nsect>0) THEN
534 DO i=1,nspmd
535 shift_sect(1,1,i) = 0
536 shift_sect(1,2,i) = rindex_proc(1,1,i)
537 shift_sect(1,3,i) = rindex_proc(1,2,i)
538 DO jj=2,nsect
539 shift_sect(jj,1,i) = rindex_proc(jj-1,3,i)
540 shift_sect(jj,2,i) = rindex_proc(jj,1,i)
541 shift_sect(jj,3,i) = rindex_proc(jj,2,i)
542 ENDDO
543 ENDDO
544
545 DO jj=1,nsect
546 ! ----------------
547 ! SHELL
548 ! ----------------
549 DO i=1,nspmd
550 len = rindex_proc(jj,1,i) - shift_sect(jj,1,i)
551 IF(len>0) THEN
552 indice = 1 + shift_r(i) + shift_sect(jj,1,i)
553 CALL write_i_c(buffer00_r(indice),len)
554 ENDIF
555 ENDDO
556 ! ----------------
557 ! SHELL3N
558 ! ----------------
559 DO i=1,nspmd
560 len = rindex_proc(jj,2,i) - rindex_proc(jj,1,i)
561 IF(len>0) THEN
562 indice = 1 + shift_r(i) + shift_sect(jj,2,i)
563 CALL write_i_c(buffer00_r(indice),len)
564 ENDIF
565 ENDDO
566 ! ----------------
567 ! SOLID
568 ! ----------------
569 DO i=1,nspmd
570 len = rindex_proc(jj,3,i) - rindex_proc(jj,2,i)
571 IF(len>0) THEN
572 indice = 1 + shift_r(i) + shift_sect(jj,3,i)
573 CALL write_i_c(buffer00_r(indice),len)
574 ENDIF
575 ENDDO
576 ENDDO
577 ENDIF
578
579
580
581 IF (ispmd==0) THEN
582 n0 = numnodg + nodcut + nsect
583 n1 = numnodg + nodcut + nsect + nrwall
584
585 DO n=1,nrwall
586 ii(1) = n0
587 ii(2) = n0
588 ii(3) = n0
589 ii(4) = n0
590 CALL write_i_c(ii,4)
591 n0 = n0 + 1
592 k=1
593 n2=n +nrwall
594 n3=n2+nrwall
595 n4=n3+nrwall
596 ityp= nprw(n4)
597
598 IF(iabs(ityp)==1.OR.ityp==4)THEN
599 ii(1) = n1
600 ii(2) = n1 + 3
601 ii(3) = n1 + 2
602 ii(4) = n1 + 1
603 CALL write_i_c(ii,4)
604 n1 = n1 + 4
605 ELSEIF(ityp==2)THEN
606 n10 = n1
607 DO j = 1,23
608 ii(1) = n1
609 ii(2) = n1 + 2
610 ii(3) = n1 + 3
611 ii(4) = n1 + 1
612 CALL write_i_c(ii,4)
613 n1 = n1 + 2
614 ENDDO
615 ii(1) = n1
616 ii(2) = n10
617 ii(3) = n10 + 1
618 ii(4) = n1 + 1
619 CALL write_i_c(ii,4)
620 n1 = n1 + 2
621 ELSEIF(ityp==3)THEN
622 DO i = 1,6
623 DO j = 1,6
624 DO l = 1,6
625 ii(1) = n1
626 ii(2) = n1 + 1
627 ii(3) = n1 + 8
628 ii(4) = n1 + 7
629 CALL write_i_c(ii,4)
630 n1 = n1 + 1
631 ENDDO
632 n1 = n1 + 1
633 ENDDO
634 n1 = n1 + 7
635 ENDDO
636 ENDIF
637 k=k+nprw(n)
638 IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
639 ENDDO
640 ENDIF
641
642 IF(ALLOCATED(buffer00_r)) DEALLOCATE( buffer00_r )
643
644 RETURN
645 END SUBROUTINE dparrws
my_real
#define my_real
Definition cppsort.cpp:32
dparrws
subroutine dparrws(nesbw, nstrf, ixc, ixtg, x, nodcut, rwbuf, nprw, nodglob, buf, ixs)
Definition dparrws.F:36
spmd_gather_wa
subroutine spmd_gather_wa(mode, size_buffer_s, size_buffer_r, sindex, rindex_proc, buffer_s, buffer_r, shift_r, nb_elem_r)
Definition spmd_gather_wa.F:33
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645