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 29 of file w_iradia.F.

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