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