OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admbcs.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!|| admbcs ../starter/source/model/remesh/admbcs.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| admbcs3 ../starter/source/model/remesh/admbcs.F
29!|| admbcs4 ../starter/source/model/remesh/admbcs.F
30!|| ancmsg ../starter/source/output/message/message.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE admbcs(IXC,IPARTC,IXTG,IPARTTG,IPART,
35 . ICODE,ISKEW,ITAB,SH4TREE,SH3TREE)
36 USE message_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "scr17_c.inc"
45#include "com04_c.inc"
46#include "param_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IXC(NIXC,*),IPARTC(*),IXTG(NIXTG,*),IPARTTG(*),
51 . ipart(lipart1,*),icode(*),iskew(*),itab(*),
52 . sh4tree(ksh4tree,*),sh3tree(ksh3tree,*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER IP,NLEV,N1,N2,IC1,IC2,ICOD,IS1,IS2,
57 . dir, n
58C-----------------------------------------------
59 INTEGER MY_AND
60 EXTERNAL my_and
61C-----------------------------------------------
62C
63 DO n=1,numelc0
64 ip =ipartc(n)
65 nlev =ipart(10,ip)
66 IF(nlev>0)THEN
67 DO dir=0,3
68 n1=ixc(dir+2,n)
69 n2=ixc(mod(dir+1,4)+2,n)
70 ic1 =icode(n1)
71 ic2 =icode(n2)
72 icod=my_and(ic1,ic2)
73 IF(icod/=0)THEN
74 is1=iskew(n1)
75 is2=iskew(n2)
76 IF(is1/=is2)THEN
77 CALL ancmsg(msgid=650,
78 . msgtype=msgerror,
79 . anmode=aninfo,
80 . i2=itab(n2),
81 . i1=itab(n1),
82 . i3=ixc(nixc,n))
83 END IF
84 CALL admbcs4(dir,icod,is1,n ,ixc,
85 . ipartc,ipart,icode,iskew,sh4tree)
86 END IF
87 END DO
88 END IF
89 END DO
90C
91 DO n=1,numeltg0
92 ip =iparttg(n)
93 nlev =ipart(10,ip)
94 IF(nlev>0)THEN
95 DO dir=0,2
96 n1=ixtg(dir+2,n)
97 n2=ixtg(mod(dir+1,3)+2,n)
98 ic1 =icode(n1)
99 ic2 =icode(n2)
100 icod=my_and(ic1,ic2)
101 IF(icod/=0)THEN
102 is1=iskew(n1)
103 is2=iskew(n2)
104 IF(is1/=is2)THEN
105 CALL ancmsg(msgid=650,
106 . msgtype=msgerror,
107 . anmode=aninfo,
108 . i2=itab(n2),
109 . i1=itab(n1),
110 . i3=ixtg(nixtg,n))
111 END IF
112 CALL admbcs3(dir,icod,is1,n ,ixtg,
113 . iparttg,ipart,icode,iskew,sh3tree)
114 END IF
115 END DO
116 END IF
117 END DO
118
119 RETURN
120 END
121
122
123!||====================================================================
124!|| admbcs4 ../starter/source/model/remesh/admbcs.F
125!||--- called by ------------------------------------------------------
126!|| admbcs ../starter/source/model/remesh/admbcs.F
127!||--- calls -----------------------------------------------------
128!||====================================================================
129 RECURSIVE SUBROUTINE admbcs4(DIR,ICOD ,ISK ,N ,IXC ,
130 . IPARTC,IPART,ICODE,ISKEW,SH4TREE)
131C-----------------------------------------------
132C I m p l i c i t T y p e s
133C-----------------------------------------------
134#include "implicit_f.inc"
135C-----------------------------------------------
136C G l o b a l P a r a m e t e r s
137C-----------------------------------------------
138#include "scr17_c.inc"
139#include "param_c.inc"
140C-----------------------------------------------
141C D u m m y A r g u m e n t s
142C-----------------------------------------------
143 INTEGER dir,icod,isk,N,ixc(nixc,*),
144 . ipartc(*),ipart(lipart1,*),icode(*),iskew(*),
145 . sh4tree(ksh4tree,*)
146C-----------------------------------------------
147C L o c a l V a r i a b l e s
148C-----------------------------------------------
149 INTEGER level,ip,nlev
150 INTEGER SON,m1,m2
151C-----------------------------------------------
152 INTEGER my_or
153 EXTERNAL my_or
154C-----------------------------------------------
155 level=sh4tree(3,n)
156 IF(level<0)THEN
157 level=-(level+1)
158 END IF
159 ip =ipartc(n)
160 nlev =ipart(10,ip)
161
162 IF(level<nlev)THEN
163 son=sh4tree(2,n)+dir
164 CALL admbcs4(dir,icod,isk,son,ixc,
165 . ipartc,ipart,icode,iskew,sh4tree)
166 son=sh4tree(2,n)+mod(dir+1,4)
167 CALL admbcs4(dir,icod,isk,son,ixc,
168 . ipartc,ipart,icode,iskew,sh4tree)
169 ELSE
170 m1=ixc(dir+2,n)
171 m2=ixc(mod(dir+1,4)+2,n)
172 icode(m1)=my_or(icod,icode(m1))
173 icode(m2)=my_or(icod,icode(m2))
174 iskew(m1)=isk
175 iskew(m2)=isk
176 END IF
177
178 RETURN
179 END
180!||====================================================================
181!|| admbcs3 ../starter/source/model/remesh/admbcs.F
182!||--- called by ------------------------------------------------------
183!|| admbcs ../starter/source/model/remesh/admbcs.F
184!||--- calls -----------------------------------------------------
185!||====================================================================
186 RECURSIVE SUBROUTINE admbcs3(DIR,ICOD,ISK,N,IXTG,
187 . IPARTTG,IPART,ICODE,ISKEW,SH3TREE)
188C-----------------------------------------------
189C I m p l i c i t T y p e s
190C-----------------------------------------------
191#include "implicit_f.inc"
192C-----------------------------------------------
193C G l o b a l P a r a m e t e r s
194C-----------------------------------------------
195#include "scr17_c.inc"
196#include "param_c.inc"
197C-----------------------------------------------
198C D u m m y A r g u m e n t s
199C-----------------------------------------------
200 INTEGER dir,icod,isk,n,ixtg(nixtg,*),
201 . iparttg(*),ipart(lipart1,*),icode(*),iskew(*),
202 . sh3tree(ksh3tree,*)
203C-----------------------------------------------
204C L o c a l V a r i a b l e s
205C-----------------------------------------------
206 INTEGER level,ip,nlev
207 INTEGER son,m1,m2,j
208C-----------------------------------------------
209 INTEGER my_or
210 EXTERNAL my_or
211C-----------------------------------------------
212 level=sh3tree(3,n)
213 IF(level<0)THEN
214 level=-(level+1)
215 END IF
216 ip =iparttg(n)
217 nlev =ipart(10,ip)
218
219 IF(level<nlev)THEN
220 son=sh3tree(2,n)+dir
221 CALL admbcs3(dir,icod,isk,son,ixtg,
222 . iparttg,ipart,icode,iskew,sh3tree)
223 son=sh3tree(2,n)+mod(dir+1,3)
224 CALL admbcs3(dir,icod,isk,son,ixtg,
225 . iparttg,ipart,icode,iskew,sh3tree)
226 ELSE
227 m1=ixtg(dir+2,n)
228 m2=ixtg(mod(dir+1,3)+2,n)
229 icode(m1)=my_or(icod,icode(m1))
230 icode(m2)=my_or(icod,icode(m2))
231 iskew(m1)=isk
232 iskew(m2)=isk
233 END IF
234
235 RETURN
236 END
admbcs3
recursive subroutine admbcs3(dir, icod, isk, n, ixtg, iparttg, ipart, icode, iskew, sh3tree)
Definition admbcs.F:188
admbcs4
recursive subroutine admbcs4(dir, icod, isk, n, ixc, ipartc, ipart, icode, iskew, sh4tree)
Definition admbcs.F:131
admbcs
subroutine admbcs(ixc, ipartc, ixtg, iparttg, ipart, icode, iskew, itab, sh4tree, sh3tree)
Definition admbcs.F:36
message_mod
Definition message_mod.F:1249
my_or
int my_or(int *a, int *b)
Definition precision.c:63
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889