OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22get_prev_data.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!|| i22get_prev_data ../engine/source/interfaces/int22/i22get_prev_data.F
25!||--- called by ------------------------------------------------------
26!|| i22buce ../engine/source/interfaces/intsort/i22buce.F
27!||--- uses -----------------------------------------------------
28!|| element_mod ../common_source/modules/elements/element_mod.F90
29!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
30!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
31!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!|| realloc_mod ../engine/share/modules/realloc_mod.f
33!||====================================================================
34 SUBROUTINE i22get_prev_data(
35 1 X ,II_STOK, CAND_B ,CAND_E ,ITASK,
36 2 NBRIC ,ITAB , BUFBRIC ,NCAND,
37 3 IXS ,NIN )
38C============================================================================
39C-----------------------------------------------
40C D e s c r i p t i o n
41C-----------------------------------------------
42C Interface Type22 (/INTER/TYPE22) is an FSI coupling method based on cut cell method.
43C This experimental cut cell method is not completed, abandoned, and is not an official option.
44C
45C This subroutine get data from cut cell buffer
46C in previous cycle and update new buffer with
47C consistent data if brick is sill there
48C Example :
49C * nodes which were main
50C * old volume
51C * list of previous seconds (for merge/demerge)
52C * IIAD22 is also reset for all brick in
53C previous buffer
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE i22bufbric_mod
58 USE i22tri_mod
59 USE i22edge_mod
60 USE realloc_mod
61 use element_mod , only : nixs
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66#include "comlock.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com08_c.inc"
71#include "task_c.inc"
72#include "inter22.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER CAND_B(NCAND),CAND_E(NCAND), NCAND, NIN,
77 . ITASK, NBRIC, ITAB(*),
78 . BUFBRIC(NBRIC), IXS(NIXS,*), II_STOK
79 my_real
80 . :: x(3,*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84
85 INTEGER :: POS, IAD, IADE, IB ,IBG , NBF, NBL
86
87 INTEGER :: IE, N_CUT_EDGE
88
89 INTEGER :: TAG_INDEX(NBRIC), TAG_INDEX_OLD(NBRIC), I8(9,NBRIC)
90 my_real :: r9(9,nbric), r49(4,9,nbric), r84(9,4,nbric)
91
92 INTEGER :: I,J,IDX,IBold,NUM
93
94 LOGICAL :: bFOUND
95C-----------------------------------------------
96C P r e - C o n d i t i o n s
97C-----------------------------------------------
98C INT22 > 0 already true if this subroutine is called
99C-----------------------------------------------
100C S o u r c e L i n e
101C-----------------------------------------------
102
103 nb = ncandb
104 IF(nb>i22len)THEN
105 print *, "**error inter22 : memory size allocation", nb,i22len
106 stop
107 !handle this with reallocate later
108 ENDIF
109
110 nbf = 1+itask*nb/nthread
111 nbl = (itask+1)*nb/nthread
112 nin = 1
113
114 IF(itask==0.AND.dt1/=zero)THEN
115
116 DO ib=1,nbold(nin)
117 ie = brick_list(nin,ib)%ID
118 iiad22(nin, ie) = 0
119 ENDDO
120
121 tag_index(1:nbric) = 0
122 DO i=1,nb
123 tag_index(list_b(i)) = i
124 ENDDO
125
126 tag_index_old(1:nbric) = 0
127 DO i=1,nbold(nin)
128 tag_index_old(list_b_old(nin,i)) = i
129 ENDDO
130
131 !---NewInBuffer--------!
132 DO ib=1,nb
133 idx = list_b(ib)
134 IF(tag_index(idx)/=0 .AND. tag_index_old(idx)==0)THEN
135 brick_list(nin,ib)%NewInBuffer = 1
136ccc print *, "new in buffer, IB=", ib, ixs(11,idx)
137 ELSE
138 brick_list(nin,ib)%NewInBuffer = 0
139 ENDIF
140 enddo!next IB
141
142 !---NodWasMain-------!
143 DO ib=1,nbold(nin)
144 i8(1:8,ib) = brick_list(nin,ib)%NODE(1:8)%NodWasMain !backup
145 ENDDO
146 DO ib=1,nbold(nin)
147 idx = list_b_old(nin,ib) !allocated in resol with brick_list
148 IF(tag_index(idx)>0)THEN !cell BUFBBRIC(IDX) is always in buffer
149 idx = tag_index(idx) !position in new buffer
150 brick_list(nin,idx)%NODE(1:8)%NodWasMain = i8(1:8,ib)
151 ENDIF
152 enddo!next IB
153 !---WhereWasMain-----!
154 DO ib=1,nbold(nin)
155 i8(1:8,ib) = brick_list(nin,ib)%NODE(1:8)%WhereWasMain !backup
156 ENDDO
157 DO ib=1,nbold(nin)
158 idx = list_b_old(nin,ib)
159 IF(tag_index(idx)>0)THEN
160 idx = tag_index(idx)
161 brick_list(nin,idx)%NODE(1:8)%WhereWasMain = i8(1:8,ib)
162 ENDIF
163 enddo!next IB
164
165 !--Old main volume---!
166 DO ib=1,nbold(nin)
167 r9(1,ib) = brick_list(nin,ib)%Vold_SCell !backup
168 ENDDO
169 brick_list(nin,1:nbold(nin))%Vold_SCell = zero
170 DO ib=1,nbold(nin)
171 idx = list_b_old(nin,ib)
172 IF(tag_index(idx)>0)THEN
173 idx = tag_index(idx)
174 brick_list(nin,idx)%Vold_SCell = r9(1,ib)
175 ENDIF
176 enddo!next IB
177 !should be removed since it is finally updated in sinit22 due to topology change.
178
179 !--Old whichcellnode-!
180 DO ib=1,nbold(nin)
181 i8(1:8,ib) = brick_list(nin,ib)%NODE(1:8)%WhichCell !backup
182 ENDDO
183 DO ib=1,nbold(nin)
184 idx = list_b_old(nin,ib)
185 IF(tag_index(idx)>0)THEN
186 idx = tag_index(idx)
187 brick_list(nin,idx)%NODE(1:8)%OLD_WhichCell = i8(1:8,ib)
188 ENDIF
189 enddo!next IB
190 !--Old current volume---!
191 DO ib=1,nbold(nin)
192 r9(1:9,ib) = brick_list(nin,ib)%POLY(1:9)%Vnew !backup
193 ENDDO
194 DO j=1,9;brick_list(nin,1:nbold(nin))%POLY(j)%Vnew = -ep30;ENDDO
195 DO ib=1,nbold(nin)
196 idx = list_b_old(nin,ib) !must be allocated in resol at the same time as brick_list
197 IF(tag_index(idx)>0)THEN !the brick bufbbric(idx) is always in the buffer
198 idx = tag_index(idx) !position in the new buffer
199 brick_list(nin,idx)%POLY(1:9)%OLD_Vnew = r9(1:9,ib)
200 ENDIF
201 enddo!next IB
202
203 !------SecndList-------!
204 DO ib=1,nbold(nin)
205 idx = list_b_old(nin,ib)
206 IF(tag_index(idx)>0)THEN
207 idx = tag_index(idx)
208 IF(brick_list(nin,ib)%SecndList%Num==0)cycle
209 old_secndlist(nin,idx)%VOL_unmerged = brick_list(nin,ib)%SecndList%VOL_unmerged
210 old_secndlist(nin,idx)%Num = brick_list(nin,ib)%SecndList%Num
211 old_secndlist(nin,idx)%NumSecndNodes = brick_list(nin,ib)%SecndList%NumSecndNodes
212 num = brick_list(nin,ib)%SecndList%Num
213 DO j=1,num
214 old_secndlist(nin,idx)%FM(j) = brick_list(nin,ib)%SecndList%FM(j)
215 old_secndlist(nin,idx)%FV(j) = brick_list(nin,ib)%SecndList%FV(j)
216 old_secndlist(nin,idx)%IV(j) = brick_list(nin,ib)%SecndList%IV(j)
217 ibold = brick_list(nin,ib)%SecndList%IBV(j)
218 old_secndlist(nin,idx)%IBV(j) = tag_index(list_b_old(nin,ibold))
219 old_secndlist(nin,idx)%ICELLv(j) = brick_list(nin,ib)%SecndList%ICELLv(j)
220 old_secndlist(nin,idx)%VOL(j) = brick_list(nin,ib)%SecndList%VOL(j)
221 old_secndlist(nin,idx)%NumNOD_Cell(j) = brick_list(nin,ib)%SecndList%NumNOD_Cell(j)
222 old_secndlist(nin,idx)%ListNodID(j,1:8) = brick_list(nin,ib)%SecndList%ListNodID(j,1:8)
223 old_secndlist(nin,idx)%SURF_V(j) = brick_list(nin,ib)%SecndList%SURF_v(j)
224 ENDDO
225 DO j=num+1,24
226 old_secndlist(nin,idx)%FM(j) = 0
227 old_secndlist(nin,idx)%FV(j) = 0
228 old_secndlist(nin,idx)%IV(j) = 0
229 old_secndlist(nin,idx)%IBV(j) = 0
230 old_secndlist(nin,idx)%ICELLv(j) = 0
231 old_secndlist(nin,idx)%VOL(j) = zero
232 old_secndlist(nin,idx)%NumNOD_Cell(j) = 0
233 old_secndlist(nin,idx)%ListNodID(j,1:8) = 0
234 ENDDO
235 ENDIF
236 enddo!next IB
237 !---OldMainStrongNode----!
238 DO ib=1,nbold(nin)
239 i8(1,ib) = brick_list(nin,ib)%OldMainStrongNode !save before making the modification below
240 ENDDO
241 DO ib=1,nbold(nin)
242 idx = list_b_old(nin,ib)
243 IF(tag_index(idx)>0)THEN
244 idx = tag_index(idx)
245 brick_list(nin,idx)%OldMainStrongNode = i8(1,ib)
246 ENDIF
247 enddo!next IB
248 !---OldMainStrongNode----!
249 DO ib=1,nbold(nin)
250 i8(1,ib) = brick_list(nin,ib)%NBCUT
251 ENDDO
252 DO ib=1,nbold(nin)
253 idx = list_b_old(nin,ib)
254 IF(tag_index(idx)>0)THEN
255 idx = tag_index(idx)
256 brick_list(nin,idx)%WasCut = 0
257 IF(i8(1,ib)>0)brick_list(nin,idx)%WasCut = 1
258 ENDIF
259 enddo!next IB
260
261 !---old_ICODE----!
262 DO ib=1,nbold(nin)
263 i8(1,ib) = brick_list(nin,ib)%ICODE !backup
264 ENDDO
265 brick_list(nin,1:nb)%OLD_ICODE = 0
266 DO ib=1,nbold(nin)
267 idx = list_b_old(nin,ib)
268 IF(tag_index(idx)>0)THEN
269 idx = tag_index(idx)
270 brick_list(nin,idx)%OLD_ICODE = i8(1,ib)
271 ENDIF
272 enddo!next IB
273
274
275 endif!IF(ITASK==0)THEN
276
277
278 if(itask==0.AND.ibug22_tri==1)then
279 print *, "I22LEN =", i22len
280 print *, "II_STOK =", ii_stok
281 print *, " NB =", nb
282 endif
283
284 IF(itask==0) THEN
285 nbold(nin) = nb
286 list_b_old(nin,1:nb) = list_b(1:nb)
287 ENDIF
288
289
290 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
i22get_prev_data
subroutine i22get_prev_data(x, ii_stok, cand_b, cand_e, itask, nbric, itab, bufbric, ncand, ixs, nin)
Definition i22get_prev_data.F:38
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22edge_mod::old_secndlist
type(list_secnd), dimension(:,:), allocatable old_secndlist
Definition cut-cell-buffer_mod.F:233
i22edge_mod::list_b_old
integer, dimension(:,:), allocatable list_b_old
Definition cut-cell-buffer_mod.F:53
i22edge_mod::iiad22
integer, dimension(:,:), allocatable iiad22
Definition cut-cell-buffer_mod.F:54
i22edge_mod::nbold
integer, dimension(:), allocatable nbold
Definition cut-cell-buffer_mod.F:52
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
i22tri_mod::ibug22_tri
integer ibug22_tri
Definition cut-cell-search_mod.F:231
i22tri_mod::list_b
integer, dimension(:), allocatable list_b
Definition cut-cell-search_mod.F:495
i22tri_mod::ncandb
integer ncandb
Definition cut-cell-search_mod.F:499
realloc_mod
Definition realloc_mod.F:29