OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iwcontdd_type25.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!|| iwcontdd_type25 ../starter/source/spmd/domain_decomposition/iwcontdd_type25.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE iwcontdd_type25(NLEDGE,NUMNOD,NSN,NMN,IEDGE,NRTM,NEDGE,NSV,MSR,IRECT,IWCONT,NSNT,NMNT,INTBUF_TAB)
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
174 END SUBROUTINE iwcontdd_type25
iwcontdd_type25
subroutine iwcontdd_type25(nledge, numnod, nsn, nmn, iedge, nrtm, nedge, nsv, msr, irect, iwcont, nsnt, nmnt, intbuf_tab)
Definition iwcontdd_type25.F:30