OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
velvec.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!|| velvec ../engine/source/output/anim/generate/velvec.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_anim_ply_velvec ../engine/source/mpi/anim/spmd_anim_ply_velvec.F
29!|| spmd_vgath ../engine/source/mpi/anim/spmd_vgath.F
30!|| write_r_c ../common_source/tools/input_output/write_routines.c
31!||--- uses -----------------------------------------------------
32!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
33!||====================================================================
34 SUBROUTINE velvec(V,V_TEMP,IVOIS,AL,NODCUT,NNWL,NNSRG,
35 . NODGLOB,WEIGHT,NFVNOD,IFUNC,
36 . NFNOD_PXFEM,NOD,INDX,NFNOD_CRKXFEMG,ITAB)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE plyxfem_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 "task_c.inc"
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "scr14_c.inc"
52#include "spmd_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NODGLOB(*),WEIGHT(*),NOD(*),INDX(*)
57 INTEGER,INTENT(IN) :: ITAB(NUMNOD)
59 . v(3,numnod),al(*),v_temp(3,*)
61 . s3000,s
62 REAL R4
63 REAL, DIMENSION(:,:), ALLOCATABLE :: PLYVELVEC
64 INTEGER I,IVOIS(2,*),NODCUT,NNWL,BUF
65 INTEGER NNSRG,NFVNOD,IFUNC,NFNOD_PXFEM,ND,EMPL,NFNOD_CRKXFEMG
66C-----------------------------------------------
67 INTEGER N,IPLY,JJ,EMPSIZPL
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71 s3000 = 3000.
72 s = zero
73C
74 IF (nspmd == 1) THEN
75 DO i=1,numnod
76 r4 = v(1,i)
77 CALL write_r_c(r4,1)
78 r4 = v(2,i)
79 CALL write_r_c(r4,1)
80 r4 = v(3,i)
81 CALL write_r_c(r4,1)
82 ENDDO
83 IF (numelig3d /= 0)THEN
84 DO i=1,64*numelig3d
85 r4 = v_temp(1,i)
86 CALL write_r_c(r4,1)
87 r4 = v_temp(2,i)
88 CALL write_r_c(r4,1)
89 r4 = v_temp(3,i)
90 CALL write_r_c(r4,1)
91 ENDDO
92 ENDIF
93 ELSE
94 IF (ispmd==0) THEN
95 buf = numnodg
96 ELSE
97 buf = 1
98 ENDIF
99 CALL spmd_vgath(v,nodglob,weight,buf)
100 ENDIF
101 IF(nodcut>0)THEN
102 IF (nspmd > 1) THEN
103 IF (ispmd==0) THEN
104 print *, '** NODCUT NON PARALLELIZED OPTION!'
105 END IF
106 GO TO 211
107 END IF
108 DO i=1,nodcut
109 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
110 CALL write_r_c(r4,1)
111 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
112 CALL write_r_c(r4,1)
113 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
114 CALL write_r_c(r4,1)
115 ENDDO !next I
116 211 CONTINUE
117 ENDIF
118C
119 IF (ispmd==0) THEN
120 r4 = 0.
121 DO i=1,nsect+nrwall+nnwl+nnsrg
122 CALL write_r_c(r4,1)
123 CALL write_r_c(r4,1)
124 CALL write_r_c(r4,1)
125 ENDDO
126 ENDIF
127C
128C node ply xfem
129C
130 IF(anim_ply > 0 ) THEN
131 IF (nspmd == 1) THEN
132 IF (nfnod_pxfem>0) THEN
133 IF(ifunc == 1) THEN
134 ALLOCATE(plyvelvec(3,nfnod_pxfem))
135 DO jj =1,nplypart
136 iply = indx(jj)
137 DO nd=1,plynod(iply)%PLYNUMNODS
138 i = plynod(iply)%NODES(nd)
139 empl = plynod(iply)%PLYNODID(nd)
140 n = nod(i)
141 plyvelvec(1,empl) = ply(iply)%V(1,n)
142 plyvelvec(2,empl) = ply(iply)%V(2,n)
143 plyvelvec(3,empl) = ply(iply)%V(3,n)
144 ENDDO
145 ENDDO
146 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
147 DEALLOCATE(plyvelvec)
148C
149 ELSEIF(ifunc == 2)THEN
150 ALLOCATE(plyvelvec(3,nfnod_pxfem))
151 DO jj =1,nplypart
152 iply = indx(jj)
153 DO nd=1,plynod(iply)%PLYNUMNODS
154 i = plynod(iply)%NODES(nd)
155 empl = plynod(iply)%PLYNODID(nd)
156 n = nod(i)
157 plyvelvec(1,empl) = ply(iply)%U(1,n)
158 plyvelvec(2,empl) = ply(iply)%U(2,n)
159 plyvelvec(3,empl) = ply(iply)%U(3,n)
160 ENDDO
161 ENDDO
162 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
163 DEALLOCATE(plyvelvec)
164
165 ELSEIF(ifunc == 3) THEN
166 ALLOCATE(plyvelvec(3,nfnod_pxfem))
167 DO jj =1,nplypart
168 iply = indx(jj)
169 DO nd=1,plynod(iply)%PLYNUMNODS
170 i = plynod(iply)%NODES(nd)
171 empl = plynod(iply)%PLYNODID(nd)
172 n = nod(i)
173 plyvelvec(1,empl) = ply(iply)%A(1,n)
174 plyvelvec(2,empl) = ply(iply)%A(2,n)
175 plyvelvec(3,empl) = ply(iply)%A(3,n)
176 ENDDO
177 ENDDO
178 CALL write_r_c(plyvelvec,3*nfnod_pxfem)
179 DEALLOCATE(plyvelvec)
180 ELSE
181 r4 = zero
182 DO i=1,nfnod_pxfem
183 CALL write_r_c(r4,1)
184 CALL write_r_c(r4,1)
185 CALL write_r_c(r4,1)
186 ENDDO
187 ENDIF
188 ENDIF
189 ELSE
190C
191 empsizpl = 0
192 DO jj =1,nplypart
193 iply = indx(jj)
194 CALL spmd_anim_ply_velvec( nodglob,iply,
195 * nod, ifunc,empsizpl )
196 ENDDO
197 ENDIF
198 ENDIF
199c----------------------------
200C nodes crk xfem
201c----------------------------
202 IF (anim_crk > 0 ) THEN
203 IF (ispmd == 0) THEN
204 r4 = zero
205 DO i=1,nfnod_crkxfemg
206 CALL write_r_c(r4,1)
207 CALL write_r_c(r4,1)
208 CALL write_r_c(r4,1)
209 ENDDO
210 ENDIF
211 ENDIF
212c----------------------------
213 IF (ispmd==0)THEN
214 IF (nfvnod>0) THEN
215 r4 = 0.
216 DO i=1,nfvnod+3
217 CALL write_r_c(r4,1)
218 CALL write_r_c(r4,1)
219 CALL write_r_c(r4,1)
220 ENDDO
221 ENDIF
222 ENDIF
223C-------------
224 RETURN
225 END
226
227!||====================================================================
228!|| velvec2 ../engine/source/output/anim/generate/velvec.F
229!||--- called by ------------------------------------------------------
230!|| genani ../engine/source/output/anim/generate/genani.F
231!||--- calls -----------------------------------------------------
232!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.F
233!|| spmd_velvec2 ../engine/source/mpi/anim/spmd_velvec2.F
234!|| write_r_c ../common_source/tools/input_output/write_routines.c
235!||--- uses -----------------------------------------------------
236!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
237!||====================================================================
238 SUBROUTINE velvec2(IVOIS,V_TEMP,AL ,NODCUT,FOPT,
239 . NPBY,NNWL ,NNSRG,NODGLOB,WEIGHT,FR_SEC,
240 . NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG)
241C-----------------------------------------------
242C I m p l i c i t T y p e s
243C-----------------------------------------------
244 USE my_alloc_mod
245#include "implicit_f.inc"
246C-----------------------------------------------
247C C o m m o n B l o c k s
248C-----------------------------------------------
249#include "param_c.inc"
250#include "task_c.inc"
251#include "com01_c.inc"
252#include "com04_c.inc"
253#include "scr14_c.inc"
254#include "spmd_c.inc"
255C-----------------------------------------------
256C D u m m y A r g u m e n t s
257C-----------------------------------------------
258C REAL
259 my_real
260 . al(*),fopt(6,*),v_temp(3,*)
261
262 REAL R4
263 INTEGER IVOIS(2,*),NPBY(NNPBY,*),NODCUT,NNWL
264 INTEGER NNSRG,NFNOD_PXFEM,NFNOD_PXFEMG
265 INTEGER I,N,WEIGHT(*),FR_SEC(NSPMD+1,*)
266
267 INTEGER NODGLOB(*),RBUF,NNG
268 INTEGER NFVNOD,NFNOD_CRKXFEMG
269C-----------------------------------------------
270C L o c a l V a r i a b l e s
271C----------------------------------------------
272 my_real, DIMENSION(:,:),ALLOCATABLE :: rwa
273 my_real, DIMENSION(:,:),ALLOCATABLE :: rwal
274 my_real, DIMENSION(:,:),ALLOCATABLE :: v
275 INTEGER LOC_PROC,PMAIN
276C=======================================================================
277 CALL my_alloc(rwa,3,nsect)
278 CALL my_alloc(rwal,3,nrwall)
279 CALL my_alloc(v,3,numnod)
280 loc_proc = ispmd + 1
281C
282 DO i=1,numnod
283 v(1,i) = zero
284 v(2,i) = zero
285 v(3,i) = zero
286 ENDDO
287C
288 IF (nspmd==1) THEN
289 DO n=1,nrbody
290 i = npby(1,n)
291 v(1,i) = fopt(1,nsect+n)
292 v(2,i) = fopt(2,nsect+n)
293 v(3,i) = fopt(3,nsect+n)
294 ENDDO
295C
296 ELSE
297 DO n=1,nrbody
298 i = npby(1,n)
299 IF (i>0) THEN
300 IF (weight(i)==1) THEN
301 v(1,i) = fopt(1,nsect+n)
302 v(2,i) = fopt(2,nsect+n)
303 v(3,i) = fopt(3,nsect+n)
304 ENDIF
305 ENDIF
306 ENDDO
307
308 ENDIF
309C
310 IF (nspmd == 1) THEN
311 DO i=1,numnod
312 r4 = v(1,i)
313 CALL write_r_c(r4,1)
314 r4 = v(2,i)
315 CALL write_r_c(r4,1)
316 r4 = v(3,i)
317 CALL write_r_c(r4,1)
318 ENDDO
319 IF (numelig3d /= 0)THEN
320 DO i=1,64*numelig3d
321 r4 = v_temp(1,i)
322 CALL write_r_c(r4,1)
323 r4 = v_temp(2,i)
324 CALL write_r_c(r4,1)
325 r4 = v_temp(3,i)
326 CALL write_r_c(r4,1)
327 ENDDO
328 ENDIF
329 ELSE
330 IF (ispmd==0) THEN
331 rbuf = numnodm
332 nng = numnodg
333 ELSE
334 rbuf = 1
335 nng = 1
336 ENDIF
337 CALL spmd_velvec2(v,nodglob,rbuf,nng)
338 ENDIF
339
340C
341C NODCUT Non -paralle
342 IF(nodcut>0)THEN
343 IF (nspmd > 1) THEN
344 IF (ispmd==0)THEN
345 print *, '** NODCUT NON PARALLELIZED OPTION'
346 ENDIF
347 GOTO 211
348 END IF
349 DO 210 i=1,nodcut
350 r4 =al(i)*v(1,ivois(2,i))+(one -al(i))*v(1,ivois(1,i))
351 CALL write_r_c(r4,1)
352 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
353 CALL write_r_c(r4,1)
354 r4 =al(i)*v(3,ivois(2,i))+(one -al(i))*v(3,ivois(1,i))
355 CALL write_r_c(r4,1)
356 210 CONTINUE
357 211 CONTINUE
358 ENDIF
359C
360 IF (nspmd==1) THEN
361 DO i=1,nsect
362 r4 = fopt(1,i)
363 CALL write_r_c(r4,1)
364 r4 = fopt(2,i)
365 CALL write_r_c(r4,1)
366 r4 = fopt(3,i)
367 CALL write_r_c(r4,1)
368 ENDDO
369 ELSE
370 DO i=1,nsect
371 pmain = fr_sec(nspmd+1,i)
372 IF (pmain ==loc_proc) THEN
373 rwa(1,i) = fopt(1,i)
374 rwa(2,i) = fopt(2,i)
375 rwa(3,i) = fopt(3,i)
376 ELSE
377 rwa(1,i) = zero
378 rwa(2,i) = zero
379 rwa(3,i) = zero
380 ENDIF
381 ENDDO
382 IF(nsect>0)
383 . CALL spmd_glob_dsum9(rwa,3*nsect)
384 IF (ispmd==0) THEN
385 DO i=1,nsect
386 r4 = rwa(1,i)
387 CALL write_r_c(r4,1)
388 r4 = rwa(2,i)
389 CALL write_r_c(r4,1)
390 r4 = rwa(3,i)
391 CALL write_r_c(r4,1)
392 ENDDO
393 ENDIF
394 ENDIF
395C
396 IF (nspmd==1) THEN
397 DO i=1,nrwall
398 r4 = fopt(1,nsect+nrbody+i)
399 CALL write_r_c(r4,1)
400 r4 = fopt(2,nsect+nrbody+i)
401 CALL write_r_c(r4,1)
402 r4 = fopt(3,nsect+nrbody+i)
403 CALL write_r_c(r4,1)
404 ENDDO
405 ELSE
406 DO i=1,nrwall
407 rwal(1,i) = fopt(1,nsect+nrbody+i)
408 rwal(2,i) = fopt(2,nsect+nrbody+i)
409 rwal(3,i) = fopt(3,nsect+nrbody+i)
410 ENDDO
411 IF (nrwall>0)
412 . CALL spmd_glob_dsum9(rwal,3*nrwall)
413 IF (ispmd==0) THEN
414 DO i=1,nrwall
415 r4 = rwal(1,i)
416 CALL write_r_c(r4,1)
417 r4 = rwal(2,i)
418 CALL write_r_c(r4,1)
419 r4 = rwal(3,i)
420 CALL write_r_c(r4,1)
421 ENDDO
422 ENDIF
423 ENDIF
424 IF (ispmd/=0) GO TO 300
425 r4 = 0.
426 DO i=1,nnwl
427 CALL write_r_c(r4,1)
428 CALL write_r_c(r4,1)
429 CALL write_r_c(r4,1)
430 ENDDO
431 r4=zero
432 DO i=1,nnsrg
433 CALL write_r_c(r4,1)
434 CALL write_r_c(r4,1)
435 CALL write_r_c(r4,1)
436 ENDDO
437C
438 IF(anim_ply > 0 ) THEN
439 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
440 r4 = zero
441 DO i=1,nfnod_pxfemg
442 CALL write_r_c(r4,1)
443 CALL write_r_c(r4,1)
444 CALL write_r_c(r4,1)
445 ENDDO
446 ENDIF
447 ENDIF
448c----------------------------
449C nodes crk xfem
450c----------------------------
451 IF (anim_crk > 0 ) THEN
452 IF (ispmd == 0) THEN
453 r4 = zero
454 DO i=1,nfnod_crkxfemg
455 CALL write_r_c(r4,1)
456 CALL write_r_c(r4,1)
457 CALL write_r_c(r4,1)
458 ENDDO
459 ENDIF
460 ENDIF
461c----------------------------
462 IF (nfvnod>0) THEN
463 r4=zero
464 DO i=1,nfvnod+3
465 CALL write_r_c(r4,1)
466 CALL write_r_c(r4,1)
467 CALL write_r_c(r4,1)
468 ENDDO
469 ENDIF
470 300 CONTINUE
471C-----------
472 DEALLOCATE(rwa)
473 DEALLOCATE(rwal)
474 DEALLOCATE(v)
475 RETURN
476 END
477
478!||====================================================================
479!|| velvecc ../engine/source/output/anim/generate/velvec.f
480!||--- called by ------------------------------------------------------
481!|| genani ../engine/source/output/anim/generate/genani.F
482!||--- calls -----------------------------------------------------
483!|| spmd_glob_fsum9 ../engine/source/mpi/interfaces/spmd_th.F
484!|| write_r_c ../common_source/tools/input_output/write_routines.c
485!||--- uses -----------------------------------------------------
486!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
487!||====================================================================
488 SUBROUTINE velvecc(V,V_TEMP,IVOIS,AL,NODCUT,NNWL,NNSRG,
489 . NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,
490 . NFNOD_PXFEMG,NFNOD_CRKXFEMG)
491C-----------------------------s------------------
492C I m p l i c i t T y p e s
493C-----------------------------------------------
494 USE my_alloc_mod
495#include "implicit_f.inc"
496C-----------------------------------------------
497C C o m m o n B l o c k s
498C-----------------------------------------------
499#include "task_c.inc"
500#include "com01_c.inc"
501#include "com04_c.inc"
502#include "scr14_c.inc"
503#include "spmd_c.inc"
504C-----------------------------------------------
505C D u m m y A r g u m e n t s
506C-----------------------------------------------
507 INTEGER NODGLOB(*),WEIGHT(*)
508C REAL
509 my_real
510 . V(3,*),AL(*),V_TEMP(3,*)
511C REAL
512 my_real
513 . s3000,s
514 REAL R4
515 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K
516 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
517C-----------------------------------------------
518C L o c a l V a r i a b l e s
519C-----------------------------------------------
520 REAL, DIMENSION(:,:), ALLOCATABLE :: VG
521C-----------------------------------------------
522 CALL my_alloc(vg,3,numnodg)
523 s3000 = 3000.
524 s = zero
525
526 IF (nspmd == 1) THEN
527 DO i=1,numnod
528 r4 = v(1,i)
529 CALL write_r_c(r4,1)
530 r4 = v(2,i)
531 CALL write_r_c(r4,1)
532 r4 = v(3,i)
533 CALL write_r_c(r4,1)
534 ENDDO
535 IF (numelig3d /= 0)THEN
536 DO i=1,64*numelig3d
537 r4 = v_temp(1,i)
538 CALL write_r_c(r4,1)
539 r4 = v_temp(2,i)
540 CALL write_r_c(r4,1)
541 r4 = v_temp(3,i)
542 CALL write_r_c(r4,1)
543 ENDDO
544 ENDIF
545 ELSE
546 DO i=1,numnodg
547 vg(1,i)=zero
548 vg(2,i)=zero
549 vg(3,i)=zero
550 ENDDO
551 DO k=1,numnod
552 i=nodglob(k)
553 vg(1,i)=v(1,k)
554 vg(2,i)=v(2,k)
555 vg(3,i)=v(3,k)
556 ENDDO
557
558 CALL spmd_glob_fsum9(vg,3*numnodg)
559
560 IF (ispmd==0) THEN
561 DO i=1,numnodg
562 CALL write_r_c(vg(1,i),1)
563 CALL write_r_c(vg(2,i),1)
564 CALL write_r_c(vg(3,i),1)
565 ENDDO
566 ENDIF
567 ENDIF
568
569C
570C option non parallelisee !
571 IF(nodcut>0)THEN
572 IF (nspmd > 1) THEN
573 IF (ispmd==0) THEN
574 print *, '** NODCUT NON PARALLELIZED OPTION'
575 END IF
576 GO TO 211
577 END IF
578 DO 210 i=1,nodcut
579 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
580 CALL write_r_c(r4,1)
581 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
582 CALL write_r_c(r4,1)
583 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
584 CALL write_r_c(r4,1)
585 210 CONTINUE
586 211 CONTINUE
587 ENDIF
588C
589 IF(anim_ply > 0 ) THEN
590
591 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
592 r4 = zero
593 DO i=1,nfnod_pxfemg
594 CALL write_r_c(r4,1)
595 CALL write_r_c(r4,1)
596 CALL write_r_c(r4,1)
597 ENDDO
598 ENDIF
599 ENDIF
600c----------------------------
601C nodes crk xfem
602c----------------------------
603 IF (anim_crk > 0 ) THEN
604 IF (ispmd == 0) THEN
605 r4 = zero
606 DO i=1,nfnod_crkxfemg
607 CALL write_r_c(r4,1)
608 CALL write_r_c(r4,1)
609 CALL write_r_c(r4,1)
610 ENDDO
611 ENDIF
612 ENDIF
613c----------------------------
614 IF (ispmd==0) THEN
615 r4 = 0.
616 DO i=1,nsect+nrwall+nnwl+nnsrg
617 CALL write_r_c(r4,1)
618 CALL write_r_c(r4,1)
619 CALL write_r_c(r4,1)
620 ENDDO
621 IF (nfvnod>0) THEN
622 r4 = 0.
623 DO i=1,nfvnod+3
624 CALL write_r_c(r4,1)
625 CALL write_r_c(r4,1)
626 CALL write_r_c(r4,1)
627 ENDDO
628 ENDIF
629 endif!(ISPMD==0)
630c----------------------------
631 DEALLOCATE(vg)
632 RETURN
633 END
634
635!||====================================================================
636!|| velvecc21 ../engine/source/output/anim/generate/velvec.F
637!||--- called by ------------------------------------------------------
638!|| genani ../engine/source/output/anim/generate/genani.F
639!||--- calls -----------------------------------------------------
640!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.F
641!|| write_r_c ../common_source/tools/input_output/write_routines.c
642!||====================================================================
643 SUBROUTINE velvecc21(V,V_TEMP,IVOIS,AL,NODCUT,NNWL,
644 . NNSRG,NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,
645 . NFNOD_PXFEMG,VG21,NFNOD_CRKXFEMG)
646C-----------------------------s------------------
647C I m p l i c i t T y p e s
648C-----------------------------------------------
649#include "implicit_f.inc"
650C-----------------------------------------------
651C C o m m o n B l o c k s
652C-----------------------------------------------
653#include "task_c.inc"
654#include "com01_c.inc"
655#include "com04_c.inc"
656#include "scr14_c.inc"
657#include "spmd_c.inc"
658C-----------------------------------------------
659C D u m m y A r g u m e n t s
660C-----------------------------------------------
661 INTEGER NODGLOB(*),WEIGHT(*)
662C REAL
663 my_real
664 . V(3,*),AL(*),VG21(3,*),V_TEMP(3,*)
665C REAL
666 my_real
667 . S3000,S
668 REAL R4
669 INTEGER I,IVOIS(2,*),NODCUT,NNWL,K
670 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
671 my_real
672 . , DIMENSION(:,:), ALLOCATABLE :: v_tmp
673C-----------------------------------------------
674 s3000 = 3000.
675 s = zero
676C
677 IF (nspmd == 1) THEN
678 DO k=1,numnod
679 i=nodglob(k)
680 r4 = vg21(1,i)+v(1,k)
681 CALL write_r_c(r4,1)
682 r4 = vg21(2,i)+v(2,k)
683 CALL write_r_c(r4,1)
684 r4 = vg21(3,i)+v(3,k)
685 CALL write_r_c(r4,1)
686 ENDDO
687 IF (numelig3d /= 0)THEN
688 DO i=1,64*numelig3d
689 r4 = v_temp(1,i)
690 CALL write_r_c(r4,1)
691 r4 = v_temp(2,i)
692 CALL write_r_c(r4,1)
693 r4 = v_temp(3,i)
694 CALL write_r_c(r4,1)
695 ENDDO
696 ENDIF
697 ELSE
698 ALLOCATE(v_tmp(3,numnodg))
699 DO i=1,numnodg
700 v_tmp(1,i) =vg21(1,i)
701 v_tmp(2,i) =vg21(2,i)
702 v_tmp(3,i) =vg21(3,i)
703 ENDDO
704
705 DO k=1,numnod
706 i=nodglob(k)
707 v_tmp(1,i)=v_tmp(1,i)+v(1,k)
708 v_tmp(2,i)=v_tmp(2,i)+v(2,k)
709 v_tmp(3,i)=v_tmp(3,i)+v(3,k)
710 ENDDO
711
712 CALL spmd_glob_dsum9(v_tmp,3*numnodg)
713
714 IF(ispmd==0)THEN
715 DO i=1,numnodg
716 r4 = v_tmp(1,i)
717 CALL write_r_c(r4,1)
718 r4 = v_tmp(2,i)
719 CALL write_r_c(r4,1)
720 r4 = v_tmp(3,i)
721 CALL write_r_c(r4,1)
722 ENDDO
723 ENDIF
724 DEALLOCATE(v_tmp)
725 ENDIF
726C
727C option non parallelisee !
728 IF(nodcut>0)THEN
729 IF (nspmd > 1) THEN
730 IF (ispmd==0) THEN
731 print *, '** NODCUT NON PARALLELIZED OPTION'
732 END IF
733 GO TO 211
734 END IF
735 DO 210 i=1,nodcut
736 r4 =al(i)*v(1,ivois(2,i))+(one-al(i))*v(1,ivois(1,i))
737 CALL write_r_c(r4,1)
738 r4 =al(i)*v(2,ivois(2,i))+(one -al(i))*v(2,ivois(1,i))
739 CALL write_r_c(r4,1)
740 r4 =al(i)*v(3,ivois(2,i))+(one-al(i))*v(3,ivois(1,i))
741 CALL write_r_c(r4,1)
742 210 CONTINUE
743 211 CONTINUE
744 ENDIF
745C
746 IF(anim_ply > 0 ) THEN
747
748 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
749 r4 = zero
750 DO i=1,nfnod_pxfemg
751 CALL write_r_c(r4,1)
752 CALL write_r_c(r4,1)
753 CALL write_r_c(r4,1)
754 ENDDO
755 ENDIF
756 ENDIF
757c----------------------------
758C nodes crk xfem
759c----------------------------
760 IF (anim_crk > 0 ) THEN
761 IF (ispmd == 0) THEN
762 r4 = zero
763 DO i=1,nfnod_crkxfemg
764 CALL write_r_c(r4,1)
765 CALL write_r_c(r4,1)
766 CALL write_r_c(r4,1)
767 ENDDO
768 ENDIF
769 ENDIF
770c----------------------------
771 IF (ispmd/=0) GOTO 300
772 r4 = 0.
773 DO i=1,nsect+nrwall+nnwl+nnsrg
774 CALL write_r_c(r4,1)
775 CALL write_r_c(r4,1)
776 CALL write_r_c(r4,1)
777 ENDDO
778C
779 IF (nfvnod>0) THEN
780 r4 = 0.
781 DO i=1,nfvnod+3
782 CALL write_r_c(r4,1)
783 CALL write_r_c(r4,1)
784 CALL write_r_c(r4,1)
785 ENDDO
786 ENDIF
787C
788 300 CONTINUE
789 RETURN
790 END
791
792!||====================================================================
793!|| velvecc_max ../engine/source/output/anim/generate/velvec.F
794!||--- called by ------------------------------------------------------
795!|| genani ../engine/source/output/anim/generate/genani.F
796!||--- calls -----------------------------------------------------
797!|| write_r_c ../common_source/tools/input_output/write_routines.c
798!||====================================================================
799 SUBROUTINE velvecc_max(VMAX,NODCUT,NNWL,NNSRG,NFVNOD,
800 . NFNOD_PXFEMG,NFNOD_CRKXFEMG)
801C-----------------------------s------------------
802C I m p l i c i t T y p e s
803C-----------------------------------------------
804#include "implicit_f.inc"
805C-----------------------------------------------
806C C o m m o n B l o c k s
807C-----------------------------------------------
808#include "task_c.inc"
809#include "com01_c.inc"
810#include "com04_c.inc"
811#include "scr14_c.inc"
812#include "spmd_c.inc"
813C-----------------------------------------------
814C D u m m y A r g u m e n t s
815C-----------------------------------------------
816 my_real
817 . vmax(3,*)
818 REAL R4
819 INTEGER I,NODCUT,NNWL
820 INTEGER NNSRG,NFVNOD,NFNOD_PXFEMG,NFNOD_CRKXFEMG
821C-----------------------------------------------
822
823 IF (NSPMD == 1) then
824 DO i=1,numnod
825 r4 = vmax(1,i)
826 CALL write_r_c(r4,1)
827 r4 = vmax(2,i)
828 CALL write_r_c(r4,1)
829 r4 = vmax(3,i)
830 CALL write_r_c(r4,1)
831 ENDDO
832 ELSE
833
834 IF (ispmd==0) THEN
835
836 DO i=1,numnodg
837 r4 = vmax(1,i)
838 CALL write_r_c(r4,1)
839 r4 = vmax(2,i)
840 CALL write_r_c(r4,1)
841 r4 = vmax(3,i)
842 CALL write_r_c(r4,1)
843 ENDDO
844 ENDIF
845 ENDIF
846
847C
848C option non parallelisee !
849 IF(nodcut>0)THEN
850 IF (nspmd > 1) THEN
851 IF (ispmd==0) THEN
852 print *, '** NODCUT NON PARALLELIZED OPTION'
853 END IF
854 GO TO 211
855 END IF
856 DO 210 i=1,nodcut ! put to zero for the moment option not supported
857 r4 =0.
858 CALL write_r_c(r4,1)
859 r4 =0.
860 CALL write_r_c(r4,1)
861 r4 =0.
862 CALL write_r_c(r4,1)
863 210 CONTINUE
864 211 CONTINUE
865 ENDIF
866C
867 IF(anim_ply > 0 ) THEN
868
869 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
870 r4 = zero
871 DO i=1,nfnod_pxfemg
872 CALL write_r_c(r4,1)
873 CALL write_r_c(r4,1)
874 CALL write_r_c(r4,1)
875 ENDDO
876 ENDIF
877 ENDIF
878c----------------------------
879C nodes crk xfem
880c----------------------------
881 IF (anim_crk > 0 ) THEN
882 IF (ispmd == 0) THEN
883 r4 = zero
884 DO i=1,nfnod_crkxfemg
885 CALL write_r_c(r4,1)
886 CALL write_r_c(r4,1)
887 CALL write_r_c(r4,1)
888 ENDDO
889 ENDIF
890 ENDIF
891c----------------------------
892 IF (ispmd/=0) GOTO 300
893 r4 = 0.
894 DO i=1,nsect+nrwall+nnwl+nnsrg
895 CALL write_r_c(r4,1)
896 CALL write_r_c(r4,1)
897 CALL write_r_c(r4,1)
898 ENDDO
899C
900 IF (nfvnod>0) THEN
901 r4 = 0.
902 DO i=1,nfvnod+3
903 CALL write_r_c(r4,1)
904 CALL write_r_c(r4,1)
905 CALL write_r_c(r4,1)
906 ENDDO
907 ENDIF
908C
909 300 CONTINUE
910
911c----------------------------
912 RETURN
913 END
914
915!||====================================================================
916!|| velvec3 ../engine/source/output/anim/generate/velvec.F
917!||--- called by ------------------------------------------------------
918!|| genani ../engine/source/output/anim/generate/genani.F
919!||--- calls -----------------------------------------------------
920!|| spmd_vgath ../engine/source/mpi/anim/spmd_vgath.F
921!|| write_r_c ../common_source/tools/input_output/write_routines.c
922!||--- uses -----------------------------------------------------
923!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
924!||====================================================================
925 SUBROUTINE velvec3(V,V_TEMP,VALE,IVOIS,AL,NODCUT,NNWL,NNSRG,
926 . NODGLOB,WEIGHT,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,
927 . NFNOD_CRKXFEMG)
928C-----------------------------s------------------
929C I m p l i c i t T y p e s
930C-----------------------------------------------
931 USE my_alloc_mod
932#include "implicit_f.inc"
933C-----------------------------------------------
934C C o m m o n B l o c k s
935C-----------------------------------------------
936#include "task_c.inc"
937#include "com01_c.inc"
938#include "com04_c.inc"
939#include "spmd_c.inc"
940#include "scr14_c.inc"
941C-----------------------------------------------
942C D u m m y A r g u m e n t s
943C-----------------------------------------------
944 INTEGER NODGLOB(*),WEIGHT(*)
945C REAL
946 my_real
947 . V(3,*),VALE(3,*),AL(*),V_TEMP(3,*)
948C REAL
949 my_real
950 . S3000,S
951 REAL R4
952 INTEGER I,IVOIS(2,*),NODCUT,NNWL,BUF
953 INTEGER NNSRG,NFVNOD,NFNOD_PXFEM,NFNOD_PXFEMG,NFNOD_CRKXFEMG
954C-----------------------------------------------
955C L o c a l V a r i a b l e s
956C-----------------------------------------------
957 my_real, DIMENSION(:,:), ALLOCATABLE :: vglobal
958C-----------------------------------------------
959 CALL my_alloc(vglobal,3,numnod)
960 s3000 = 3000.
961 s = 0.
962C
963 IF (ispmd==0) THEN
964 buf = numnodg
965 ELSE
966 buf = 1
967 ENDIF
968
969 IF (nspmd == 1)THEN
970 DO i=1,numnod
971 r4 = v(1,i)+vale(1,i)
972 CALL write_r_c(r4,1)
973 r4 = v(2,i)+vale(2,i)
974 CALL write_r_c(r4,1)
975 r4 = v(3,i)+vale(3,i)
976 CALL write_r_c(r4,1)
977 ENDDO
978 IF (numelig3d /= 0)THEN
979 DO i=1,64*numelig3d
980 r4 = v_temp(1,i)
981 CALL write_r_c(r4,1)
982 r4 = v_temp(2,i)
983 CALL write_r_c(r4,1)
984 r4 = v_temp(3,i)
985 CALL write_r_c(r4,1)
986 ENDDO
987 ENDIF
988 ELSE
989 DO i=1,numnod
990 vglobal(1,i)=v(1,i)+vale(1,i)
991 vglobal(2,i)=v(2,i)+vale(2,i)
992 vglobal(3,i)=v(3,i)+vale(3,i)
993 ENDDO
994 CALL spmd_vgath(vglobal,nodglob,weight,buf)
995 ENDIF
996C
997C option non parallelisee !
998 IF(nodcut>0)THEN
999 IF (ispmd==0) THEN
1000 print *, '** NODCUT NON PARALLELIZED OPTION'
1001 END IF
1002 ENDIF
1003C
1004 IF (ispmd/=0) GOTO 300
1005 r4 = 0.
1006 DO i=1,nsect+nrwall+nnwl+nnsrg
1007 CALL write_r_c(r4,1)
1008 CALL write_r_c(r4,1)
1009 CALL write_r_c(r4,1)
1010 ENDDO
1011C
1012 IF(anim_ply > 0 ) THEN
1013 IF(ispmd==0 .AND. nfnod_pxfemg>0) THEN
1014 r4 = zero
1015 DO i=1,nfnod_pxfemg
1016 CALL write_r_c(r4,1)
1017 CALL write_r_c(r4,1)
1018 CALL write_r_c(r4,1)
1019 ENDDO
1020 ENDIF
1021 ENDIF
1022c----------------------------
1023C nodes crk xfem
1024c----------------------------
1025 IF (anim_crk > 0 ) THEN
1026 IF (ispmd == 0) THEN
1027 r4 = zero
1028 DO i=1,nfnod_crkxfemg
1029 CALL write_r_c(r4,1)
1030 CALL write_r_c(r4,1)
1031 CALL write_r_c(r4,1)
1032 ENDDO
1033 ENDIF
1034 ENDIF
1035c----------------------------
1036 IF (ispmd==0.AND.nfvnod>0) THEN
1037 r4 = 0.
1038 DO i=1,nfvnod+3
1039 CALL write_r_c(r4,1)
1040 CALL write_r_c(r4,1)
1041 CALL write_r_c(r4,1)
1042 ENDDO
1043 ENDIF
1044C-------------
1045 300 CONTINUE
1046 DEALLOCATE(vglobal)
1047 RETURN
1048 END
1049
1050
1051
1052!||====================================================================
1053!|| velvecc22 ../engine/source/output/anim/generate/velvec.F
1054!||--- called by ------------------------------------------------------
1055!|| genani ../engine/source/output/anim/generate/genani.F
1056!||--- calls -----------------------------------------------------
1057!|| write_r_c ../common_source/tools/input_output/write_routines.c
1058!||--- uses -----------------------------------------------------
1059!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1060!|| element_mod ../common_source/modules/elements/element_mod.F90
1061!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
1062!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
1063!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
1064!|| initbuf_mod ../engine/share/resol/initbuf.F
1065!||====================================================================
1066 SUBROUTINE velvecc22(ELBUF_TAB,IPARG,IFLG,IXS,IXQ,ITAB)
1067C-----------------------------------------------
1068C D e s c r i p t i o n
1069C-----------------------------------------------
1070C This subroutines writes at polyedra centroids :
1071C velocities (IFLG=1),
1072C momentum density (IFLG=2)
1073C internal forces (IFLG=3),
1074C for coupling interface 22. Free nodes are used
1075C as marker to plot centroid vectors
1076C(see input card for grnod_id)
1077C-----------------------------------------------
1078C M o d u l e s
1079C-----------------------------------------------
1080 USE initbuf_mod
1081 USE elbufdef_mod
1082 USE i22bufbric_mod
1083 USE i22edge_mod
1084 USE i22tri_mod
1085 use element_mod , only : nixs,nixq
1086C-----------------------------------------------
1087C I m p l i c i t T y p e s
1088C-----------------------------------------------
1089#include "implicit_f.inc"
1090C-----------------------------------------------
1091C C o m m o n B l o c k s
1092C-----------------------------------------------
1093#include "com01_c.inc"
1094#include "com04_c.inc"
1095#include "param_c.inc"
1096C-----------------------------------------------
1097C D u m m y A r g u m e n t s
1098C-----------------------------------------------
1099 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IFLG,IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),ITAB(NUMNOD)
1100 REAL R4
1101 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
1102 TYPE(BUF_MAT_),POINTER :: MBUF
1103 TYPE(G_BUFEL_),POINTER :: GBUF
1104C-----------------------------------------------
1105C L o c a l A r g u m e n t s
1106C-----------------------------------------------
1107 INTEGER :: NGM, IDLOCM, IBM,ICELLM,MLW,NCELL,NELm,NBF,NBL,ICELL,NIN,NODE_ID,IB,I
1108 my_real :: rho_cell, RHO(4), VFRAC(4)
1109 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
1110C-----------------------------------------------
1111
1112 !---------------------------------------------------------!
1113 nbf = 1
1114 nbl = nb
1115 nin = 1
1116 !---------------------------------------------------------!
1117 ALLOCATE(buffer(3,numnod))
1118 buffer(:,:) = zero
1119
1120 DO ib=nbf,nbl
1121 icell = 0
1122 ncell = brick_list(nin,ib)%NBCUT
1123 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
1124 icell = icell +1
1125 IF (icell>ncell .AND. ncell/=0)icell=9
1126 ibm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(4)
1127 icellm = brick_list(nin,ibm)%mainID
1128 IF(ibm==0)THEN
1129 ibm = ib
1130 icellm = 1
1131 ENDIF
1132 ngm = brick_list(nin,ibm)%NG
1133 idlocm = brick_list(nin,ibm)%IDLOC
1134 gbuf =>elbuf_tab(ngm)%GBUF
1135 mbuf =>elbuf_tab(ngm)%BUFLY(1)%MAT(1,1,1)
1136 nelm = iparg(2,ngm)
1137 mlw = iparg(1,ngm)
1138 IF(mlw==37)THEN
1139 !UVAR(I,1) : massic percentage of liquid * global density (rho1*V1/V : it needs to give liquid mass multiplying by element volume in aleconve.F)
1140 !UVAR(I,2) : density of gas
1141 !UVAR(I,3) : density of liquid
1142 !UVAR(I,4) : volumetric fraction of liquid
1143 !UVAR(I,5) : volumetric fraction of gas
1144 rho(1) = mbuf%VAR((3-1)*nelm+idlocm)
1145 rho(2) = mbuf%VAR((2-1)*nelm+idlocm)
1146 vfrac(1) = mbuf%VAR((4-1)*nelm+idlocm)
1147 vfrac(2) = mbuf%VAR((5-1)*nelm+idlocm)
1148 rho_cell = rho(1)*vfrac(1) + rho(2)*vfrac(2)
1149 ELSEIF(mlw==51)THEN
1150 rho(1) = zero
1151 rho(2) = zero
1152 rho_cell = zero
1153 ELSE
1154 rho_cell = gbuf%RHO(idlocm)
1155 ENDIF
1156 node_id = brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
1157 IF(node_id<=0)cycle ! not enough nodes in the group or SMP disabling
1158 IF(iflg==1)THEN
1159 !velocity vector : U
1160 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm) / rho_cell
1161 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm) / rho_cell
1162 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm) / rho_cell
1163 ELSEIF(iflg==2)THEN
1164 !momentum density vector : rho.U
1165 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm)
1166 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm)
1167 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm)
1168 ELSEIF(iflg==3)THEN
1169 !internal force at centroid = sum(integral(P.dS))
1170 buffer(1,node_id) = brick_list(nin,ibm)%FCELL(1)
1171 buffer(2,node_id) = brick_list(nin,ibm)%FCELL(2)
1172 buffer(3,node_id) = brick_list(nin,ibm)%FCELL(3)
1173 ELSE
1174 buffer(1,node_id) = zero
1175 buffer(2,node_id) = zero
1176 buffer(3,node_id) = zero
1177 ENDIF
1178 ENDDO !next ICELL
1179 enddo!next IB
1180
1181 DO i=1,numnod
1182 r4 = buffer(1,i)
1183 CALL write_r_c(r4,1)
1184 r4 = buffer(2,i)
1185 CALL write_r_c(r4,1)
1186 r4 = buffer(3,i)
1187 CALL write_r_c(r4,1)
1188 enddo!next I
1189
1190 DEALLOCATE(buffer)
1191 !---------------------------------------------------------!
1192
1193 RETURN
1194 END
#define my_real
Definition cppsort.cpp:32
subroutine velvecc(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:491
subroutine velvecc_max(vmax, nodcut, nnwl, nnsrg, nfvnod, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:801
subroutine velvecc22(elbuf_tab, iparg, iflg, ixs, ixq, itab)
Definition velvec.F:1067
subroutine velvec(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, ifunc, nfnod_pxfem, nod, indx, nfnod_crkxfemg, itab)
Definition velvec.F:37
subroutine velvec3(v, v_temp, vale, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:928
subroutine velvecc21(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, vg21, nfnod_crkxfemg)
Definition velvec.F:646
subroutine velvec2(ivois, v_temp, al, nodcut, fopt, npby, nnwl, nnsrg, nodglob, weight, fr_sec, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:241
type(brick_entity), dimension(:,:), allocatable, target brick_list
type(plynods), dimension(:), allocatable plynod
Definition plyxfem_mod.F:44
type(ply_data), dimension(:), allocatable ply
Definition plyxfem_mod.F:92
integer nplypart
Definition plyxfem_mod.F:59
subroutine spmd_anim_ply_velvec(nodglob, iply, nod_pxfem, ifunc, empsizpl)
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:379
subroutine spmd_glob_fsum9(v, len)
Definition spmd_th.F:302
subroutine spmd_velvec2(v, nodglob, rbuf, numpog)
subroutine spmd_vgath(x, nodglob, weight, num)
Definition spmd_vgath.F:35
void write_r_c(float *w, int *len)