OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iwcontdd_type25.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine iwcontdd_type25 (nledge, numnod, nsn, nmn, iedge, nrtm, nedge, nsv, msr, irect, iwcont, nsnt, nmnt, intbuf_tab)

Function/Subroutine Documentation

◆ iwcontdd_type25()

subroutine iwcontdd_type25 ( integer, intent(in) nledge,
integer, intent(in) numnod,
integer, intent(in) nsn,
integer, intent(in) nmn,
integer, intent(in) iedge,
integer, intent(in) nrtm,
integer, intent(in) nedge,
integer, dimension(nsn), intent(in) nsv,
integer, dimension(nmn), intent(in) msr,
integer, dimension(4,nrtm), intent(in) irect,
integer, dimension(5,numnod), intent(inout) iwcont,
integer, intent(inout) nsnt,
integer, intent(inout) nmnt,
type(intbuf_struct_), intent(in) intbuf_tab )
Parameters
[in]nledgesize of edge arrays
[in]numnodnumber nodes
[in]nsnnumber of S nodes
[in]nmnnumber of M nodes
[in]iedgeflag for edge / edge
[in]nrtmnumber of segment
[in]nedgenumber of edge
[in]nsvlist of S nodes
[in]msrlist of M nodes
[in]irectid of the 4 nodes of the segment
[in,out]nsnttotal number of S node for all interfaces
[in,out]nmnttotal number of M node for all interfaces
[in]intbuf_tabinterface structure

Definition at line 29 of file iwcontdd_type25.F.

30!$COMMENT
31! IWCONTDD_TYPE25 description :
32! update the weight of nodes belonging to an interface type 25
33! to balance the sorting of the engine
34!
35! IWCONTDD_TYPE25 organization :
36! for S node :
37! * add the weight to the S node
38! for M node :
39! * add the weight to the m node
40! for edge to edge :
41! * add the weight to the 4 M nodes (e2s)
42! * add the weight to the 2 M nodes (e2e)
43! * add the weight to the 2 S nodes (e2e)
44!$ENDCOMMENT
45 USE intbufdef_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER, INTENT(in) :: NLEDGE !< size of edge arrays
54 INTEGER, INTENT(in) :: NUMNOD !< number nodes
55 INTEGER, INTENT(in) :: NSN !< number of S nodes
56 INTEGER, INTENT(in) :: NMN !< number of M nodes
57 INTEGER, INTENT(in) :: IEDGE !< flag for edge / edge
58 INTEGER, INTENT(in) :: NRTM !< number of segment
59 INTEGER, INTENT(in) :: NEDGE !< number of edge
60 INTEGER, DIMENSION(NSN), INTENT(in) :: NSV !< list of S nodes
61 INTEGER, DIMENSION(NMN), INTENT(in) :: MSR !< list of M nodes
62 INTEGER, DIMENSION(4,NRTM), INTENT(in) :: IRECT !< id of the 4 nodes of the segment
63 INTEGER, DIMENSION(5,NUMNOD), INTENT(inout) :: IWCONT ! weight array for the interface
64 INTEGER, INTENT(inout) :: NSNT !< total number of S node for all interfaces
65 INTEGER, INTENT(inout) :: NMNT !< total number of M node for all interfaces
66 TYPE(INTBUF_STRUCT_), INTENT(in) :: INTBUF_TAB !< interface structure
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER :: I
71 INTEGER :: S_NODE_ID,M_NODE_ID,S_NODE_ID_2
72 INTEGER :: NODE_ID_1,NODE_ID_2,NODE_ID_3,NODE_ID_4 ! node id
73 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_NODE
74C-----------------------------------------------
75
76 ! ---------------------------
77 ! loop over the S nodes
78 DO i = 1,nsn
79 s_node_id = nsv(i)
80 iwcont(1,s_node_id) = iwcont(1,s_node_id)+1
81 nsnt = nsnt + 1
82 ENDDO
83 ! ---------------------------
84
85 ! ---------------------------
86 ! loop over the M nodes
87 DO i = 1,nmn
88 m_node_id = msr(i)
89 iwcont(2,m_node_id) = iwcont(2,m_node_id)+1
90 nmnt = nmnt + 1
91 ENDDO
92 ! ---------------------------
93
94
95 ! ---------------------------
96 ! special treatment for edge to edge
97 IF(iedge/=0) THEN
98 ALLOCATE(tag_node(numnod))
99 tag_node(1:numnod) = 0
100 ! ------------
101 ! S node for e2e & e2s
102 DO i=1,nedge
103 node_id_1 = intbuf_tab%LEDGE((i-1)*nledge+5)
104 node_id_2 = intbuf_tab%LEDGE((i-1)*nledge+6)
105 IF(intbuf_tab%LEDGE((i-1)*nledge+7)<0) cycle
106 IF(tag_node(node_id_1)==0) THEN
107 iwcont(1,node_id_1) = iwcont(1,node_id_1)+1
108 tag_node(node_id_1) = 1
109 nsnt = nsnt + 1
110 ENDIF
111 IF(tag_node(node_id_2)==0) THEN
112 iwcont(1,node_id_2) = iwcont(1,node_id_2)+1
113 tag_node(node_id_2) = 1
114 nsnt = nsnt + 1
115 ENDIF
116 ENDDO
117 ! ------------
118 tag_node(1:numnod) = 0
119 ! ------------
120 ! M node for e2e
121 DO i=1,nedge
122 IF(iabs(intbuf_tab%LEDGE((i-1)*nledge+7))==1) cycle ! Main solid edge
123 node_id_1 = intbuf_tab%LEDGE((i-1)*nledge+5)
124 node_id_2 = intbuf_tab%LEDGE((i-1)*nledge+6)
125 IF(tag_node(node_id_1)==0) THEN
126 iwcont(2,node_id_1) = iwcont(2,node_id_1)+1
127 tag_node(node_id_1) = 1
128 nmnt = nmnt + 1
129 ENDIF
130 IF(tag_node(node_id_2)==0) THEN
131 iwcont(2,node_id_2) = iwcont(2,node_id_2)+1
132 tag_node(node_id_2) = 1
133 nmnt = nmnt + 1
134 ENDIF
135 ENDDO
136 ! ------------
137 tag_node(1:numnod) = 0
138 ! ------------
139 ! M node for e2s
140 DO i=1,nrtm
141 IF(intbuf_tab%MSEGTYP24(i)/=0) cycle ! not a solid edge
142 node_id_1 = irect(1,i)
143 node_id_2 = irect(2,i)
144 node_id_3 = irect(3,i)
145 node_id_4 = irect(4,i)
146
147 IF(tag_node(node_id_1)==0) THEN
148 iwcont(2,node_id_1) = iwcont(2,node_id_1)+1
149 tag_node(node_id_1) = 1
150 nmnt = nmnt + 1
151 ENDIF
152 IF(tag_node(node_id_2)==0) THEN
153 iwcont(2,node_id_2) = iwcont(2,node_id_2)+1
154 tag_node(node_id_2) = 1
155 nmnt = nmnt + 1
156 ENDIF
157 IF(tag_node(node_id_3)==0) THEN
158 iwcont(2,node_id_3) = iwcont(2,node_id_3)+1
159 tag_node(node_id_3) = 1
160 nmnt = nmnt + 1
161 ENDIF
162 IF(tag_node(node_id_4)==0) THEN
163 iwcont(2,node_id_4) = iwcont(2,node_id_4)+1
164 tag_node(node_id_4) = 1
165 nmnt = nmnt + 1
166 ENDIF
167 ENDDO
168 ! ------------
169 DEALLOCATE(tag_node)
170 ENDIF
171 ! ---------------------------
172
173 RETURN
the
end diagonal values have been computed in the(sparse) matrix id.SOL
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91