OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_fxbody.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "fxbcom.inc"
#include "com01_c.inc"
#include "scr15_c.inc"
#include "units_c.inc"
#include "units_fxbody_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c_fxbody1 (fxbipm, fxbnod, nodlocal, iparg, fxbelm, lennod_l, lenmod_l, lenelm_l, lensig_l, proc, lengrvi_l, fxbgrvi)
subroutine c_fxbody2 (fxbipm, fxbnod, nodlocal, iparg, fxbelm, fxbnod_l, fxbmod_l, fxbelm_l, fxbsig_l, proc, fxbmod, fxbsig, fxbipm_l, fxbgrvi, fxbgrvi_l, lennod_l, itask)
subroutine c_fxbody3 (lenglm_l, lencp_l, lenlm_l, lenfls_l, lendls_l, lenmcd_l, lengrvr_l, fxbipm_l, proc)
subroutine c_fxbody4 (fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbgrvr, fxbipm, proc, fxbglm_l, fxbcpm_l, fxbcps_l, fxblm_l, fxbfls_l, fxbdls_l, fxbgrvr_l, fxbipm_l)

Function/Subroutine Documentation

◆ c_fxbody1()

subroutine c_fxbody1 ( integer, dimension(nbipm,*) fxbipm,
integer, dimension(*) fxbnod,
integer, dimension(*) nodlocal,
integer, dimension(nparg,*) iparg,
integer, dimension(*) fxbelm,
integer lennod_l,
integer lenmod_l,
integer lenelm_l,
integer lensig_l,
integer proc,
integer lengrvi_l,
integer, dimension(*) fxbgrvi )

Definition at line 28 of file c_fxbody.F.

32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com04_c.inc"
40#include "param_c.inc"
41#include "fxbcom.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER FXBIPM(NBIPM,*), FXBNOD(*), NODLOCAL(*), IPARG(NPARG,*),
46 . FXBELM(*), LENNOD_L, LENMOD_L, LENELM_L, LENSIG_L, PROC,
47 . LENGRVI_L, FXBGRVI(*)
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER NFX, NSN, NSNI, IFILE, ANOD, I, II, AELM, NELS, NELC,
52 . NELT, NELP, NELTG, NG, P, NSN_L, NSNI_L, NMOD, NME,
53 . NLG, AGRVI, IADG, IG, NNO, NNO_L
54C
55 lennod_l=0
56 lenmod_l=0
57 lenelm_l=0
58 lensig_l=0
59 lengrvi_l=0
60 DO nfx=1,nfxbody
61 nsn=fxbipm(3,nfx)
62 nsni=fxbipm(18,nfx)
63 nmod=fxbipm(4,nfx)
64 nme=fxbipm(17,nfx)
65 ifile=fxbipm(29,nfx)
66C Modes
67 anod=fxbipm(6,nfx)
68 nsn_l=0
69 nsni_l=0
70 DO i=1,nsni
71 ii=fxbnod(anod+i-1)
72 IF (nodlocal(ii)/=0) THEN
73 nsn_l=nsn_l+1
74 nsni_l=nsni_l+1
75 ENDIF
76 ENDDO
77 DO i=nsni+1,nsn
78 ii=fxbnod(anod+i-1)
79 IF (nodlocal(ii)/=0) nsn_l=nsn_l+1
80 ENDDO
81 lennod_l=lennod_l+nsn_l
82 IF (ifile==0) THEN
83 lenmod_l=lenmod_l+nsn_l*(nme+nmod)
84 ELSEIF (ifile==1) THEN
85 lenmod_l=lenmod_l+nsni_l*(nme+nmod)
86 ENDIF
87C Champs de contraintes
88 aelm=fxbipm(19,nfx)
89 nels=fxbipm(21,nfx)
90 nelc=fxbipm(22,nfx)
91 nelt=fxbipm(34,nfx)
92 nelp=fxbipm(35,nfx)
93 neltg=fxbipm(23,nfx)
94 DO i=1,nels
95 ng=fxbelm(aelm)
96 p=iparg(32,ng)
97 IF (p==proc) THEN
98 lenelm_l=lenelm_l+13
99 IF (ifile==0) lensig_l=lensig_l+7*nmod
100 ENDIF
101 aelm=aelm+13
102 ENDDO
103 DO i=1,nelc
104 ng=fxbelm(aelm)
105 p=iparg(32,ng)
106 IF (p==proc) THEN
107 lenelm_l=lenelm_l+10
108 IF (ifile==0) lensig_l=lensig_l+10*nmod
109 ENDIF
110 aelm=aelm+10
111 ENDDO
112 DO i=1,nelt
113 ng=fxbelm(aelm)
114 p=iparg(32,ng)
115 IF (p==proc) THEN
116 lenelm_l=lenelm_l+7
117 IF (ifile==0) lensig_l=lensig_l+2*nmod
118 ENDIF
119 aelm=aelm+7
120 ENDDO
121 DO i=1,nelp
122 ng=fxbelm(aelm)
123 p=iparg(32,ng)
124 IF (p==proc) THEN
125 lenelm_l=lenelm_l+9
126 IF (ifile==0) lensig_l=lensig_l+8*nmod
127 ENDIF
128 aelm=aelm+9
129 ENDDO
130 DO i=1,neltg
131 ng=fxbelm(aelm)
132 p=iparg(32,ng)
133 IF (p==proc) THEN
134 lenelm_l=lenelm_l+9
135 IF (ifile==0) lensig_l=lensig_l+10*nmod
136 ENDIF
137 aelm=aelm+9
138 ENDDO
139C Gravite
140 nlg=fxbipm(25,nfx)
141 agrvi=fxbipm(26,nfx)
142 iadg=0
143 DO ig=1,nlg
144 nno=fxbgrvi(agrvi+iadg+1)
145 nno_l=0
146 DO i=1,nno
147 ii=fxbgrvi(agrvi+iadg+i+1)
148 IF (nodlocal(ii)/=0) nno_l=nno_l+1
149 ENDDO
150 iadg=iadg+2+nno
151 lengrvi_l=lengrvi_l+2+nno_l
152 ENDDO
153 ENDDO
154C
155 RETURN

◆ c_fxbody2()

subroutine c_fxbody2 ( integer, dimension(nbipm,*) fxbipm,
integer, dimension(*) fxbnod,
integer, dimension(*) nodlocal,
integer, dimension(nparg,*) iparg,
integer, dimension(*) fxbelm,
integer, dimension(*) fxbnod_l,
fxbmod_l,
integer, dimension(*) fxbelm_l,
fxbsig_l,
integer proc,
fxbmod,
fxbsig,
integer, dimension(nbipm,*) fxbipm_l,
integer, dimension(*) fxbgrvi,
integer, dimension(*) fxbgrvi_l,
integer lennod_l,
integer itask )

Definition at line 164 of file c_fxbody.F.

169C-----------------------------------------------
170C M o d u l e s
171C-----------------------------------------------
172C-----------------------------------------------
173C I m p l i c i t T y p e s
174C-----------------------------------------------
175#include "implicit_f.inc"
176C-----------------------------------------------
177C C o m m o n B l o c k s
178C-----------------------------------------------
179#include "com01_c.inc"
180#include "com04_c.inc"
181#include "scr15_c.inc"
182#include "param_c.inc"
183#include "units_c.inc"
184#include "units_fxbody_c.inc"
185#include "fxbcom.inc"
186C-----------------------------------------------
187C D u m m y A r g u m e n t s
188C-----------------------------------------------
189 INTEGER FXBIPM(NBIPM,*), FXBNOD(*), NODLOCAL(*), IPARG(NPARG,*),
190 . FXBELM(*), FXBNOD_L(*), FXBELM_L(*), PROC,
191 . FXBIPM_L(NBIPM,*), FXBGRVI(*),
192 . FXBGRVI_L(*), LENNOD_L
193 my_real
194 . fxbmod_l(*), fxbsig_l(*), fxbmod(*), fxbsig(*)
195C-----------------------------------------------
196C F u n c t i o n
197C-----------------------------------------------
198 INTEGER NLOCAL
199 EXTERNAL nlocal
200C-----------------------------------------------
201C L o c a l V a r i a b l e s
202C-----------------------------------------------
203 INTEGER RCLEN, LB_L, NG, P, IAD_L(NGROUP), LBUFELI, ANOD_L,
204 . AMOD_L, IRCM_L, AELM_L, ASIG_L, IRCS_L, NFX, I, NSN,
205 . NSNI, IFILE, NMOD, NME, IRCM, ANOD, AMOD, NSN_L, NSNI_L,
206 . II, ASIG, IRCS, NELS, NELC, NELT, NELP, NELTG, AELM,
207 . NELS_L, NELC_L, NELT_L, NELP_L, NELTG_L, J, K, ELM(13),
208 . LVSIG, IAD, JJ, ASIG2, ASIG_L2, LVSIG2, NMAX, PMAIN, PP,
209 . AGRVI_L, NLG, AGRVI, IADG, IADG_L, IG, NNO, NNO_L,
210 . NG_L(NGROUP), IADFXB(LENNOD_L),ITASK
211 my_real
212 . flrec6(6), var(6)
213 my_real
214 . , DIMENSION(:), ALLOCATABLE :: vsig, vsig2
215 CHARACTER(LEN=4) :: CIT
216 CHARACTER(LEN=256) :: SCR_FILE_NAME,SCR_FILE_NAME2
217C
218 INQUIRE(iolength=rclen) flrec6
219
220c initially was set in starter0, but re-set here for multi threading compatibility
221 ifxm_l = 27000
222 ifxs_l = 28000
223 nels_l = 0
224 nelc_l = 0
225 nelt_l = 0
226 nelp_l = 0
227 neltg_l = 0
228
229
230 WRITE(cit,'(I4.4)')itask
231 scr_file_name ='SCR_FXM_'//rootnam(1:rootlen)//'_'//cit(1:4)//'.scr'
232 scr_file_name2='SCR_FXS_'//rootnam(1:rootlen)//'_'//cit(1:4)//'.scr'
233
234 OPEN(unit=ifxm_l+itask,file=trim(scr_file_name),access='DIRECT',recl=rclen)
235 OPEN(unit=ifxs_l+itask,file=trim(scr_file_name2),access='DIRECT',recl=rclen)
236C
237 lb_l=1
238 ii=0
239 DO ng=1,ngroup
240 p=iparg(32,ng)
241 IF (p==proc) THEN
242 ii=ii+1
243 ng_l(ng)=ii
244 iad_l(ng)=lb_l
245 IF (ng<ngroup) THEN
246 lbufeli=iparg(4,ng+1)-iparg(4,ng)
247 ELSE
248 lbufeli=lbufel+1-iparg(4,ng)
249 ENDIF
250 lb_l=lb_l+lbufeli
251 ENDIF
252 ENDDO
253C
254 anod_l=0
255 amod_l=0
256 ircm_l=0
257 aelm_l=0
258 asig_l=0
259 ircs_l=0
260 agrvi_l=1
261 DO nfx=1,nfxbody
262 DO i=1,nbipm
263 fxbipm_l(i,nfx)=fxbipm(i,nfx)
264 ENDDO
265C Noeud Main
266 fxbipm_l(2,nfx)=nodlocal(fxbipm(2,nfx))
267C
268 nsn=fxbipm(3,nfx)
269 nsni=fxbipm(18,nfx)
270 ifile=fxbipm(29,nfx)
271 nmod=fxbipm(4,nfx)
272 nme=fxbipm(17,nfx)
273 ircm=fxbipm(30,nfx)
274C Modes
275 anod=fxbipm(6,nfx)
276 amod=fxbipm(7,nfx)
277 fxbipm_l(6,nfx)=anod_l+1
278 fxbipm_l(7,nfx)=amod_l+1
279 nsn_l=0
280 nsni_l=0
281 DO i=1,nsni
282 ii=fxbnod(anod+i-1)
283 IF (nodlocal(ii)/=0) THEN
284 nsn_l=nsn_l+1
285 nsni_l=nsni_l+1
286 anod_l=anod_l+1
287 fxbnod_l(anod_l)=nodlocal(ii)
288 iadfxb(nsn_l)=i
289 ENDIF
290 ENDDO
291 DO i=nsni+1,nsn
292 ii=fxbnod(anod+i-1)
293 IF (nodlocal(ii)/=0) THEN
294 nsn_l=nsn_l+1
295 anod_l=anod_l+1
296 fxbnod_l(anod_l)=nodlocal(ii)
297 iadfxb(nsn_l)=i
298 ENDIF
299 ENDDO
300 fxbipm_l(3,nfx)=nsn_l
301 fxbipm_l(18,nfx)=nsni_l
302 DO i=1,nsn_l
303 anod_l=anod_l+1
304 fxbnod_l(anod_l)=iadfxb(i)
305 ENDDO
306 fxbipm_l(30,nfx)=ircm_l
307 IF (ifile==0) THEN
308 DO i=1,nme+nmod
309 DO j=1,nsn
310 jj=fxbnod(anod+j-1)
311 IF (nodlocal(jj)/=0) THEN
312 DO k=1,6
313 fxbmod_l(amod_l+k)=fxbmod(amod-1+6*(j-1)+k)
314 ENDDO
315 amod_l=amod_l+6
316 ENDIF
317 ENDDO
318 amod=amod+6*nsn
319 ENDDO
320 ELSEIF (ifile==1) THEN
321 DO i=1,nme+nmod
322 DO j=1,nsni
323 jj=fxbnod(anod+j-1)
324 IF (nodlocal(jj)/=0) THEN
325 DO k=1,6
326 fxbmod_l(amod_l+k)=fxbmod(amod-1+6*(j-1)+k)
327 ENDDO
328 amod_l=amod_l+6
329 ENDIF
330 ENDDO
331 amod=amod+6*nsni
332 DO j=nsni+1,nsn
333 ircm=ircm+1
334 jj=fxbnod(anod+j-1)
335 IF (nodlocal(jj)/=0) THEN
336!$OMP CRITICAL(read_IXFM_critic)
337 READ(ifxm,rec=ircm) (var(k),k=1,6)
338!$OMP END CRITICAL(read_IXFM_critic)
339 ircm_l=ircm_l+1
340 WRITE(ifxm_l+itask,rec=ircm_l) (var(k),k=1,6)
341 ENDIF
342 ENDDO
343 ENDDO
344 ENDIF
345 fxbipm_l(32,nfx)=ircm_l
346C
347Champs de contrainte modaux
348 asig=fxbipm(20,nfx)
349 ircs=fxbipm(31,nfx)
350 nels=fxbipm(21,nfx)
351 nelc=fxbipm(22,nfx)
352 nelt=fxbipm(34,nfx)
353 nelp=fxbipm(35,nfx)
354 neltg=fxbipm(23,nfx)
355C
356 fxbipm_l(19,nfx)=aelm_l+1
357 fxbipm_l(20,nfx)=asig_l+1
358C
359 DO i=1,nmod
360 aelm=fxbipm(19,nfx)
361 nels_l=0
362 nelc_l=0
363 nelt_l=0
364 nelp_l=0
365 neltg_l=0
366 IF (ifile==0) THEN
367 DO j=1,nels
368 ng=fxbelm(aelm)
369 p=iparg(32,ng)
370 iad=iparg(4,ng)
371 IF (p==proc) THEN
372 nels_l=nels_l+1
373 IF (i==1) THEN
374 DO k=1,13
375 elm(k)=fxbelm(aelm+k-1)
376 ENDDO
377 elm(1)=ng_l(ng)
378 elm(11)=elm(11)-iad+iad_l(ng)
379 elm(12)=elm(12)-iad+iad_l(ng)
380 DO k=1,13
381 fxbelm_l(aelm_l+k)=elm(k)
382 ENDDO
383 aelm_l=aelm_l+13
384 ENDIF
385 DO k=1,7
386 fxbsig_l(asig_l+k)=fxbsig(asig+k-1)
387 ENDDO
388 asig_l=asig_l+7
389 ENDIF
390 aelm=aelm+13
391 asig=asig+7
392 ENDDO
393 DO j=1,nelc
394 ng=fxbelm(aelm)
395 p=iparg(32,ng)
396 iad=iparg(4,ng)
397 IF (p==proc) THEN
398 nelc_l=nelc_l+1
399 IF (i==1) THEN
400 DO k=1,10
401 elm(k)=fxbelm(aelm+k-1)
402 ENDDO
403 elm(1)=ng_l(ng)
404 elm(7)=elm(7)-iad+iad_l(ng)
405 elm(8)=elm(8)-iad+iad_l(ng)
406 elm(9)=elm(9)-iad+iad_l(ng)
407 DO k=1,10
408 fxbelm_l(aelm_l+k)=elm(k)
409 ENDDO
410 aelm_l=aelm_l+10
411 ENDIF
412 DO k=1,10
413 fxbsig_l(asig_l+k)=fxbsig(asig+k-1)
414 ENDDO
415 asig_l=asig_l+10
416 ENDIF
417 aelm=aelm+10
418 asig=asig+10
419 ENDDO
420 DO j=1,nelt
421 ng=fxbelm(aelm)
422 p=iparg(32,ng)
423 iad=iparg(4,ng)
424 IF (p==proc) THEN
425 nelt_l=nelt_l+1
426 IF (i==1) THEN
427 DO k=1,7
428 elm(k)=fxbelm(aelm+k-1)
429 ENDDO
430 elm(1)=ng_l(ng)
431 elm(5)=elm(5)-iad+iad_l(ng)
432 elm(6)=elm(6)-iad+iad_l(ng)
433 DO k=1,7
434 fxbelm_l(aelm_l+k)=elm(k)
435 ENDDO
436 aelm_l=aelm_l+7
437 ENDIF
438 DO k=1,2
439 fxbsig_l(asig_l+k)=fxbsig(asig+k-1)
440 ENDDO
441 asig_l=asig_l+2
442 ENDIF
443 aelm=aelm+7
444 asig=asig+2
445 ENDDO
446 DO j=1,nelp
447 ng=fxbelm(aelm)
448 p=iparg(32,ng)
449 iad=iparg(4,ng)
450 IF (p==proc) THEN
451 nelp_l=nelp_l+1
452 IF (i==1) THEN
453 DO k=1,9
454 elm(k)=fxbelm(aelm+k-1)
455 ENDDO
456 elm(1)=ng_l(ng)
457 elm(6)=elm(6)-iad+iad_l(ng)
458 elm(7)=elm(7)-iad+iad_l(ng)
459 elm(8)=elm(8)-iad+iad_l(ng)
460 DO k=1,9
461 fxbelm_l(aelm_l+k)=elm(k)
462 ENDDO
463 aelm_l=aelm_l+9
464 ENDIF
465 DO k=1,8
466 fxbsig_l(asig_l+k)=fxbsig(asig+k-1)
467 ENDDO
468 asig_l=asig_l+8
469 ENDIF
470 aelm=aelm+9
471 asig=asig+8
472 ENDDO
473 DO j=1,neltg
474 ng=fxbelm(aelm)
475 p=iparg(32,ng)
476 iad=iparg(4,ng)
477 IF (p==proc) THEN
478 neltg_l=neltg_l+1
479 IF (i==1) THEN
480 DO k=1,9
481 elm(k)=fxbelm(aelm+k-1)
482 ENDDO
483 elm(1)=ng_l(ng)
484 elm(6)=elm(6)-iad+iad_l(ng)
485 elm(7)=elm(7)-iad+iad_l(ng)
486 elm(8)=elm(8)-iad+iad_l(ng)
487 DO k=1,9
488 fxbelm_l(aelm_l+k)=elm(k)
489 ENDDO
490 aelm_l=aelm_l+9
491 ENDIF
492 DO k=1,10
493 fxbsig_l(asig_l+k)=fxbsig(asig+k-1)
494 ENDDO
495 asig_l=asig_l+10
496 ENDIF
497 aelm=aelm+9
498 asig=asig+10
499 ENDDO
500 ELSEIF (ifile==1) THEN
501 lvsig=nels*7+nelc*10+nelt*2+nelp*8+neltg*10
502 ALLOCATE(vsig(lvsig), vsig2(lvsig))
503 iad=0
504 DO j=1,lvsig/6
505 ircs=ircs+1
506!$OMP CRITICAL(read_IXFS_critic)
507 READ(ifxs,rec=ircs) (vsig(iad+k),k=1,6)
508!$OMP END CRITICAL(read_IXFS_critic)
509 iad=iad+6
510 ENDDO
511 jj=lvsig-(lvsig/6)*6
512 IF (jj>0) THEN
513 ircs=ircs+1
514!$OMP CRITICAL(read_IXFS_critic)
515 READ(ifxs,rec=ircs) (vsig(iad+k),k=1,jj)
516!$OMP END CRITICAL(read_IXFS_critic)
517 ENDIF
518C
519 asig2=0
520 asig_l2=0
521 DO j=1,nels
522 ng=fxbelm(aelm)
523 p=iparg(32,ng)
524 iad=iparg(4,ng)
525 IF (p==proc) THEN
526 nels_l=nels_l+1
527 IF (i==1) THEN
528 DO k=1,13
529 elm(k)=fxbelm(aelm+k-1)
530 ENDDO
531 elm(1)=ng_l(ng)
532 elm(11)=elm(11)-iad+iad_l(ng)
533 elm(12)=elm(12)-iad+iad_l(ng)
534 DO k=1,13
535 fxbelm_l(aelm_l+k)=elm(k)
536 ENDDO
537 aelm_l=aelm_l+13
538 ENDIF
539 DO k=1,7
540 vsig2(asig_l2+k)=vsig(asig2+k)
541 ENDDO
542 asig_l2=asig_l2+7
543 ENDIF
544 aelm=aelm+13
545 asig2=asig2+7
546 ENDDO
547 DO j=1,nelc
548 ng=fxbelm(aelm)
549 p=iparg(32,ng)
550 iad=iparg(4,ng)
551 IF (p==proc) THEN
552 nelc_l=nelc_l+1
553 IF (i==1) THEN
554 DO k=1,10
555 elm(k)=fxbelm(aelm+k-1)
556 ENDDO
557 elm(1)=ng_l(ng)
558 elm(7)=elm(7)-iad+iad_l(ng)
559 elm(8)=elm(8)-iad+iad_l(ng)
560 elm(9)=elm(9)-iad+iad_l(ng)
561 DO k=1,10
562 fxbelm_l(aelm_l+k)=elm(k)
563 ENDDO
564 aelm_l=aelm_l+10
565 ENDIF
566 DO k=1,10
567 vsig2(asig_l2+k)=vsig(asig2+k)
568 ENDDO
569 asig_l2=asig_l2+10
570 ENDIF
571 aelm=aelm+10
572 asig2=asig2+10
573 ENDDO
574 DO j=1,nelt
575 ng=fxbelm(aelm)
576 p=iparg(32,ng)
577 iad=iparg(4,ng)
578 IF (p==proc) THEN
579 nelt_l=nelt_l+1
580 IF (i==1) THEN
581 DO k=1,7
582 elm(k)=fxbelm(aelm+k-1)
583 ENDDO
584 elm(1)=ng_l(ng)
585 elm(5)=elm(5)-iad+iad_l(ng)
586 elm(6)=elm(6)-iad+iad_l(ng)
587 DO k=1,7
588 fxbelm_l(aelm_l+k)=elm(k)
589 ENDDO
590 aelm_l=aelm_l+7
591 ENDIF
592 DO k=1,2
593 vsig2(asig_l2+k)=vsig(asig2+k)
594 ENDDO
595 asig_l2=asig_l2+2
596 ENDIF
597 aelm=aelm+7
598 asig2=asig2+2
599 ENDDO
600 DO j=1,nelp
601 ng=fxbelm(aelm)
602 p=iparg(32,ng)
603 iad=iparg(4,ng)
604 IF (p==proc) THEN
605 nelp_l=nelp_l+1
606 IF (i==1) THEN
607 DO k=1,9
608 elm(k)=fxbelm(aelm+k-1)
609 ENDDO
610 elm(1)=ng_l(ng)
611 elm(6)=elm(6)-iad+iad_l(ng)
612 elm(7)=elm(7)-iad+iad_l(ng)
613 elm(8)=elm(8)-iad+iad_l(ng)
614 DO k=1,9
615 fxbelm_l(aelm_l+k)=elm(k)
616 ENDDO
617 aelm_l=aelm_l+9
618 ENDIF
619 DO k=1,8
620 vsig2(asig_l2+k)=vsig(asig2+k)
621 ENDDO
622 asig_l2=asig_l2+8
623 ENDIF
624 aelm=aelm+9
625 asig2=asig2+8
626 ENDDO
627 DO j=1,neltg
628 ng=fxbelm(aelm)
629 p=iparg(32,ng)
630 iad=iparg(4,ng)
631 IF (p==proc) THEN
632 neltg_l=neltg_l+1
633 IF (i==1) THEN
634 DO k=1,9
635 elm(k)=fxbelm(aelm+k-1)
636 ENDDO
637 elm(1)=ng_l(ng)
638 elm(6)=elm(6)-iad+iad_l(ng)
639 elm(7)=elm(7)-iad+iad_l(ng)
640 elm(8)=elm(8)-iad+iad_l(ng)
641 DO k=1,9
642 fxbelm_l(aelm_l+k)=elm(k)
643 ENDDO
644 aelm_l=aelm_l+9
645 ENDIF
646 DO k=1,10
647 vsig2(asig_l2+k)=vsig(asig2+k)
648 ENDDO
649 asig_l2=asig_l2+10
650 ENDIF
651 aelm=aelm+9
652 asig2=asig2+10
653 ENDDO
654C
655 lvsig2=nels_l*7+nelc_l*10+nelt_l*2+nelp_l*8+neltg_l*10
656 iad=0
657 DO j=1,lvsig2/6
658 ircs_l=ircs_l+1
659 WRITE(ifxs_l+itask,rec=ircs_l) (vsig2(iad+k),k=1,6)
660 iad=iad+6
661 ENDDO
662 jj=lvsig2-(lvsig2/6)*6
663 IF (jj/=0) THEN
664 ircs_l=ircs_l+1
665 WRITE(ifxs_l+itask,rec=ircs_l) (vsig2(iad+k),k=1,jj)
666 ENDIF
667 DEALLOCATE(vsig, vsig2)
668 ENDIF
669 ENDDO
670 fxbipm_l(21,nfx)=nels_l
671 fxbipm_l(22,nfx)=nelc_l
672 fxbipm_l(34,nfx)=nelt_l
673 fxbipm_l(35,nfx)=nelp_l
674 fxbipm_l(23,nfx)=neltg_l
675 fxbipm_l(33,nfx)=ircs_l
676C Gravite
677 nlg=fxbipm(25,nfx)
678 agrvi=fxbipm(26,nfx)
679 fxbipm_l(26,nfx)=agrvi_l
680 iadg=0
681 iadg_l=0
682 DO ig=1,nlg
683 fxbgrvi_l(agrvi_l+iadg_l)=fxbgrvi(agrvi+iadg)
684 nno=fxbgrvi(agrvi+iadg+1)
685 nno_l=0
686 DO i=1,nno
687 ii=fxbgrvi(agrvi+iadg+i+1)
688 IF (nodlocal(ii)/=0) THEN
689 nno_l=nno_l+1
690 fxbgrvi_l(agrvi_l+iadg_l+nno_l+1)=nodlocal(ii)
691 ENDIF
692 ENDDO
693 iadg=iadg+2+nno
694 fxbgrvi_l(agrvi_l+iadg_l+1)=nno_l
695 iadg_l=iadg_l+2+nno_l
696 ENDDO
697 agrvi_l=agrvi_l+iadg_l
698C Identification du PMAIN
699 nmax=0
700 pmain=1
701 DO p=1,nspmd
702 nsn_l=0
703 DO i=1,nsn
704 ii=fxbnod(anod+i-1)
705 IF(nlocal(ii,p)==1)THEN
706 DO pp = 1, p-1
707 IF(nlocal(ii,pp)==1) THEN
708 GOTO 100
709 ENDIF
710 ENDDO
711 nsn_l=nsn_l+1
712 100 CONTINUE
713 ENDIF
714 ENDDO
715 IF(nsn_l>nmax)THEN
716 pmain=p
717 nmax=nsn_l
718 ENDIF
719 ENDDO
720 fxbipm_l(39,nfx)=pmain-1
721 fxbipm_l(40,nfx)=fxbipm(18,nfx)
722 ENDDO
723 lennod_l=lennod_l*2
724C
725 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349

◆ c_fxbody3()

subroutine c_fxbody3 ( integer lenglm_l,
integer lencp_l,
integer lenlm_l,
integer lenfls_l,
integer lendls_l,
integer lenmcd_l,
integer lengrvr_l,
integer, dimension(nbipm,*) fxbipm_l,
integer proc )

Definition at line 732 of file c_fxbody.F.

735C-----------------------------------------------
736C I m p l i c i t T y p e s
737C-----------------------------------------------
738#include "implicit_f.inc"
739C-----------------------------------------------
740C C o m m o n B l o c k s
741C-----------------------------------------------
742#include "com04_c.inc"
743#include "fxbcom.inc"
744C-----------------------------------------------
745C D u m m y A r g u m e n t s
746C-----------------------------------------------
747 INTEGER LENGLM_L, LENCP_L, LENLM_L, LENFLS_L, LENDLS_L,
748 . LENMCD_L, LENGRVR_L, FXBIPM_L(NBIPM,*),
749 . PROC
750C-----------------------------------------------
751C L o c a l V a r i a b l e s
752C-----------------------------------------------
753 INTEGER NTR, NFX, NMOD, NMST, NME, NLG, PMAIN
754C
755 lenglm_l=0
756 lencp_l=0
757 lenlm_l=0
758 lenfls_l=0
759 lendls_l=0
760 lenmcd_l=0
761 lengrvr_l=0
762C
763 ntr=9
764 DO nfx=1,nfxbody
765 nmod=fxbipm_l(4,nfx)
766 nmst=fxbipm_l(5,nfx)
767 nme=fxbipm_l(17,nfx)
768 nlg=fxbipm_l(25,nfx)
769 pmain=fxbipm_l(39,nfx)
770C
771 fxbipm_l(8 ,nfx)=lenglm_l+1
772 fxbipm_l(9 ,nfx)=lencp_l+1
773 fxbipm_l(10,nfx)=lenlm_l+1
774 fxbipm_l(11,nfx)=lenfls_l+1
775 fxbipm_l(12,nfx)=lendls_l+1
776 fxbipm_l(15,nfx)=lenmcd_l+1
777 fxbipm_l(27,nfx)=lengrvr_l+1
778C
779 IF (pmain==proc) THEN
780 lenglm_l =lenglm_l +nme*(nme+1)/2
781 lencp_l =lencp_l +ntr*nmod*nme
782 lenlm_l =lenlm_l +nmod
783 lenfls_l =lenfls_l +nmst*(2*nmod-nmst+1)/2
784 lendls_l =lendls_l +nmod-nmst
785 lenmcd_l =lenmcd_l +nme*nme
786 lengrvr_l=lengrvr_l+nme*nlg+nmod*9*nlg
787 ENDIF
788 ENDDO
789C
790 RETURN

◆ c_fxbody4()

subroutine c_fxbody4 ( fxbglm,
fxbcpm,
fxbcps,
fxblm,
fxbfls,
fxbdls,
fxbgrvr,
integer, dimension(nbipm,*) fxbipm,
integer proc,
fxbglm_l,
fxbcpm_l,
fxbcps_l,
fxblm_l,
fxbfls_l,
fxbdls_l,
fxbgrvr_l,
integer, dimension(nbipm,*) fxbipm_l )

Definition at line 797 of file c_fxbody.F.

802C-----------------------------------------------
803C I m p l i c i t T y p e s
804C-----------------------------------------------
805#include "implicit_f.inc"
806C-----------------------------------------------
807C C o m m o n B l o c k s
808C-----------------------------------------------
809#include "com04_c.inc"
810#include "fxbcom.inc"
811C-----------------------------------------------
812C D u m m y A r g u m e n t s
813C-----------------------------------------------
814 INTEGER FXBIPM(NBIPM,*), FXBIPM_L(NBIPM,*), PROC
815 my_real
816 . fxbglm(*), fxbcpm(*), fxbcps(*), fxblm(*), fxbfls(*),
817 . fxbdls(*), fxbgrvr(*), fxbglm_l(*), fxbcpm_l(*),
818 . fxbcps_l(*), fxblm_l(*), fxbfls_l(*), fxbdls_l(*),
819 . fxbgrvr_l(*)
820C-----------------------------------------------
821C L o c a l V a r i a b l e s
822C-----------------------------------------------
823 INTEGER NTR, NFX, NMOD, NMST, NME, NLG, PMAIN, AGLM, ACP, ALM,
824 . AFLS, ADLS, AGRVR, AGLM_L, ACP_L, ALM_L, AFLS_L, ADLS_L,
825 . AGRVR_L, I
826C
827 ntr=9
828 DO nfx=1,nfxbody
829 nmod=fxbipm_l(4,nfx)
830 nmst=fxbipm_l(5,nfx)
831 nme=fxbipm_l(17,nfx)
832 nlg=fxbipm_l(25,nfx)
833 pmain=fxbipm_l(39,nfx)
834C
835 aglm =fxbipm(8,nfx)
836 acp =fxbipm(9,nfx)
837 alm =fxbipm(10,nfx)
838 afls =fxbipm(11,nfx)
839 adls =fxbipm(12,nfx)
840 agrvr=fxbipm(27,nfx)
841 aglm_l =fxbipm_l(8,nfx)
842 acp_l =fxbipm_l(9,nfx)
843 alm_l =fxbipm_l(10,nfx)
844 afls_l =fxbipm_l(11,nfx)
845 adls_l =fxbipm_l(12,nfx)
846 agrvr_l=fxbipm_l(27,nfx)
847C
848 IF (pmain==proc) THEN
849 DO i=1,nme*(nme+1)/2
850 fxbglm_l(aglm_l+i-1)=fxbglm(aglm+i-1)
851 ENDDO
852 DO i=1,ntr*nmod*nme
853 fxbcpm_l(acp_l+i-1)=fxbcpm(acp+i-1)
854 fxbcps_l(acp_l+i-1)=fxbcps(acp+i-1)
855 ENDDO
856 DO i=1,nmod
857 fxblm_l(alm_l+i-1)=fxblm(alm+i-1)
858 ENDDO
859 DO i=1,nmst*(2*nmod-nmst+1)/2
860 fxbfls_l(afls_l+i-1)=fxbfls(afls+i-1)
861 ENDDO
862 DO i=1,nmod-nmst
863 fxbdls_l(adls_l+i-1)=fxbdls(adls+i-1)
864 ENDDO
865 DO i=1,nme*nlg+nmod*9*nlg
866 fxbgrvr_l(agrvr_l+i-1)=fxbgrvr(agrvr+i-1)
867 ENDDO
868 ENDIF
869 ENDDO
870C
871 RETURN