OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_connectivity.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!|| multi_connectivity ../starter/source/multifluid/multi_connectivity.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE multi_connectivity( INDX_S,INDX_Q,INDX_TG,
30 1 FACE_ELM_S,FACE_ELM_Q,FACE_ELM_TG,
31 2 IXS,IXQ,IXTG,CEP,ALE_CONNECTIVITY,BOOL_ALE_TG )
32 USE multi_fvm_mod
33 USE ale_connectivity_mod
34 use element_mod , only : nixs,nixq,nixtg
35!$COMMENT
36! MULTI_CONNECTIVITY description :
37! creation of reverse connectivity
38! element / element
39! MULTI_CONNECTIVITY organization :
40! for each IE element, find the connected element
41! loop over the surfaces of the connected element
42! and save the ID of the surface of the
43! connected element
44!$ENDCOMMENT
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
57! BOOL_ALE_TG : logical, true only if 2d model + MULTI_FVM used
58! INDX_xxx : integer ; dimension=NUMELxxx ; index for the surface
59! of the remote connected element
60! FACE_ELM_xxx : integer ; dimension=(6/4/3*NUMELxxx,2) ; surface
61! of the remote connected element
62! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
63 LOGICAL, INTENT(in) :: BOOL_ALE_TG
64 INTEGER, DIMENSION(NUMELS), INTENT(inout) :: INDX_S
65 INTEGER, DIMENSION(NUMELQ), INTENT(inout) :: INDX_Q
66 INTEGER, DIMENSION(NUMELTG), INTENT(inout) :: INDX_TG
67 INTEGER, DIMENSION(6*NUMELS,2), INTENT(inout) :: FACE_ELM_S
68 INTEGER, DIMENSION(4*NUMELQ,2), INTENT(inout) :: FACE_ELM_Q
69 INTEGER, DIMENSION(3*NUMELTG,2), INTENT(inout) :: FACE_ELM_TG
70 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
71
72
73 INTEGER, DIMENSION(NIXS,*), INTENT(in) :: IXS
74 INTEGER, DIMENSION(NIXQ,*), INTENT(in) :: IXQ
75 INTEGER, DIMENSION(NIXTG,*), INTENT(in) :: IXTG
76
77 INTEGER, DIMENSION(*), INTENT(in) :: CEP
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER :: IE,I,IV,J,SHIFT,JJ,IAD1, LGTH, IAD2, LGTH2
82 INTEGER :: CURRENT_PROC,PROC,J_SAVE
83! --------------------------------------
84! solid
85 DO ie=1,numels
86 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
87 lgth = ale_connectivity%ee_connect%iad_connect(ie+1) - ale_connectivity%ee_connect%iad_connect(ie)
88 i = ie
89 current_proc = cep(i)
90 ! loop over the surface of the IE element
91 DO j = 1, lgth
92 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1) ! id of the connected element IV
93
94 IF(iv>0) THEN
95 proc = cep(iv)
96 j_save = -1
97 iad2 = ale_connectivity%ee_connect%iad_connect(iv)
98 lgth2 = ale_connectivity%ee_connect%iad_connect(iv+1)-ale_connectivity%ee_connect%iad_connect(iv)
99 ! save the connected surface if IE & IV are on 2 different proc
100 IF(current_proc/=proc) THEN
101 ! loop over the surface of the IV connected element
102 DO jj=1,lgth2
103 IF(ale_connectivity%ee_connect%connected(iad2 + jj - 1)==ie) THEN
104 j_save = jj ! find the connected surface
105 EXIT
106 ENDIF
107 ENDDO
108 indx_s(ie) = indx_s(ie) + 1
109 face_elm_s( 6*(ie-1)+indx_s(ie),1 ) = j_save
110 face_elm_s( 6*(ie-1)+indx_s(ie),2 ) = ixs(nixs,iv)
111 ENDIF
112 ENDIF
113 ENDDO
114 ENDDO
115! --------------------------------------
116! quad
117 shift = numels
118 DO ie=1,numelq
119 i = ie + shift
120 iad1 = ale_connectivity%ee_connect%iad_connect(i)
121 lgth = ale_connectivity%ee_connect%iad_connect(i+1) - ale_connectivity%ee_connect%iad_connect(i)
122 current_proc = cep(i)
123 ! loop over the surface of the IE element
124 DO j = 1, lgth
125 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1) ! id of the connected element IV
126 IF(iv>0) THEN
127 proc = cep(iv)
128 j_save = -1
129 iad2 = ale_connectivity%ee_connect%iad_connect(iv)
130 lgth2 = ale_connectivity%ee_connect%iad_connect(iv+1)-ale_connectivity%ee_connect%iad_connect(iv)
131 ! save the connected surface if IE & IV are on 2 different proc
132 IF(current_proc/=proc) THEN
133 ! loop over the surface of the IV connected element
134 DO jj=1,lgth2
135 IF(ale_connectivity%ee_connect%connected(iad2 + jj - 1)==ie) THEN
136 j_save = jj ! find the connected surface
137 EXIT
138 ENDIF
139 ENDDO
140 ! save the connected surface if IE & IV are on 2 different proc
141 indx_q(ie) = indx_q(ie) + 1
142 face_elm_q( 4*(ie-1)+indx_q(ie),1 ) = j_save
143 face_elm_q( 4*(ie-1)+indx_q(ie),2 ) = ixq(nixq,iv)
144 ENDIF
145 ENDIF
146 ENDDO
147 ENDDO
148! --------------------------------------
149! triangle
150 IF(bool_ale_tg) THEN
151 shift = numels + numelq + numelc + numelt + numelp + numelr
152 DO ie=1,numeltg
153 i = ie + shift
154 iad1 = ale_connectivity%ee_connect%iad_connect(i)
155 lgth = ale_connectivity%ee_connect%iad_connect(i+1) - ale_connectivity%ee_connect%iad_connect(i)
156 current_proc = cep(i)
157 ! loop over the surface of the IE element
158 DO j = 1, lgth
159 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)! id of the connected element IV
160 IF(iv>0) THEN
161 proc = cep(iv)
162 j_save = -1
163 iad2 = ale_connectivity%ee_connect%iad_connect(iv)
164 lgth2 = ale_connectivity%ee_connect%iad_connect(iv+1)-ale_connectivity%ee_connect%iad_connect(iv)
165 ! save the connected surface if IE & IV are on 2 different proc
166 IF(current_proc/=proc) THEN
167 ! loop over the surface of the IV connected element
168 DO jj=1,lgth2
169 IF(ale_connectivity%ee_connect%connected(iad2 + jj - 1)==ie) THEN
170 j_save = jj ! find the connected surface
171 EXIT
172 ENDIF
173 ENDDO
174 indx_tg(ie) = indx_tg(ie) + 1
175 face_elm_tg( 3*(ie-1)+indx_tg(ie),1 ) = j_save
176 face_elm_tg( 3*(ie-1)+indx_tg(ie),2 ) = ixtg(nixtg,iv)
177 ENDIF
178 ENDIF
179 ENDDO
180 ENDDO
181 ENDIF
182! --------------------------------------
183 RETURN
184 END SUBROUTINE multi_connectivity
multi_connectivity
subroutine multi_connectivity(indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, ixs, ixq, ixtg, cep, ale_connectivity, bool_ale_tg)
Definition multi_connectivity.F:32
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256