OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_iradia.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine w_iradia (ibcr, cep, proc, nodlocal, nradia_l, len_ia, cel, iparg, numlocgroup, numconv, numradia, niradia)

Function/Subroutine Documentation

◆ w_iradia()

subroutine w_iradia ( integer, dimension(niradia,*) ibcr,
integer, dimension(*) cep,
integer proc,
integer, dimension(*) nodlocal,
integer nradia_l,
integer len_ia,
integer, dimension(*) cel,
integer, dimension(nparg,*) iparg,
integer, dimension(ngroup) numlocgroup,
integer, intent(in) numconv,
integer, intent(in) numradia,
integer, intent(in) niradia )

Definition at line 30 of file w_iradia.F.

32
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com01_c.inc"
41#include "com04_c.inc"
42#include "param_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER ,INTENT(IN) :: NUMCONV
47 INTEGER ,INTENT(IN) :: NUMRADIA
48 INTEGER ,INTENT(IN) :: NIRADIA
49 INTEGER LEN_IA, PROC, NRADIA_L, IBCR(NIRADIA,*),CEP(*),
50 . NODLOCAL(*)
51 INTEGER IPARG(NPARG,*),NUMLOCGROUP(NGROUP),CEL(*)
52 INTEGER K,ID,ITY,NG,NELG,NFT
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, J, IBTMP(NIRADIA,NRADIA_L), N1, N2, N3, N4, OFF, NB_L
57C-----------------------------------------------
58C
59 off = numelc+numeltg+numels+numelq+numelt+numelp+numelr
60 + + numelx + nconld + numconv
61 nb_l = 0
62 k = 0
63C
64 DO i = 1, numradia
65 IF(cep(i+off)==proc) THEN
66 nb_l = nb_l + 1
67 n1 = ibcr(1,i)
68 n2 = ibcr(2,i)
69 n3 = ibcr(3,i)
70 n4 = ibcr(4,i)
71 ibtmp(1,nb_l) = nodlocal(n1)
72 ibtmp(2,nb_l) = nodlocal(n2)
73 ibtmp(3,nb_l) = nodlocal(n3)
74 ibtmp(4,nb_l) = 0
75 IF(n4 /= 0) ibtmp(4,nb_l) = nodlocal(n4)
76 DO j = 5, niradia
77 ibtmp(j,nb_l) = ibcr(j,i)
78 END DO
79C ============== Local numbering
80 IF(ibtmp(7,nb_l) == 1) THEN
81 id = ibtmp(8,nb_l)
82 DO ng = 1,ngroup
83 nelg = iparg(2,ng)
84 nft = iparg(3,ng)
85 ity = iparg(5,ng)
86 IF (ity == 1) THEN
87 ! Solid
88 k = id - nft
89 IF (k <= nelg) GOTO 100
90 ENDIF
91 ENDDO ! NG = 1,NGROUP
92 100 CONTINUE
93 ibtmp(niradia-1,nb_l) = numlocgroup(ng) !element local group number
94 ibtmp(niradia ,nb_l) = k ! element index in the group
95 ibtmp(8 ,nb_l) = cel(id)
96 ENDIF
97 END IF
98 END DO
99C
100 CALL write_i_c(ibtmp,niradia*nradia_l)
101 len_ia = len_ia + niradia*nradia_l
102C
103 RETURN
initmumps id
void write_i_c(int *w, int *len)