OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admbcs.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine admbcs (ixc, ipartc, ixtg, iparttg, ipart, icode, iskew, itab, sh4tree, sh3tree)
recursive subroutine admbcs4 (dir, icod, isk, n, ixc, ipartc, ipart, icode, iskew, sh4tree)
recursive subroutine admbcs3 (dir, icod, isk, n, ixtg, iparttg, ipart, icode, iskew, sh3tree)

Function/Subroutine Documentation

◆ admbcs()

subroutine admbcs ( integer, dimension(nixc,*) ixc,
integer, dimension(*) ipartc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) iparttg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 34 of file admbcs.F.

36 USE message_mod
37 use element_mod , only : nixc,nixtg
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "scr17_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IXC(NIXC,*),IPARTC(*),IXTG(NIXTG,*),IPARTTG(*),
52 . IPART(LIPART1,*),ICODE(*),ISKEW(*),ITAB(*),
53 . SH4TREE(KSH4TREE,*),SH3TREE(KSH3TREE,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER IP,NLEV,N1,N2,IC1,IC2,ICOD,IS1,IS2,
58 . DIR, N
59C-----------------------------------------------
60 INTEGER MY_AND
61 EXTERNAL my_and
62C-----------------------------------------------
63C
64 DO n=1,numelc0
65 ip =ipartc(n)
66 nlev =ipart(10,ip)
67 IF(nlev>0)THEN
68 DO dir=0,3
69 n1=ixc(dir+2,n)
70 n2=ixc(mod(dir+1,4)+2,n)
71 ic1 =icode(n1)
72 ic2 =icode(n2)
73 icod=my_and(ic1,ic2)
74 IF(icod/=0)THEN
75 is1=iskew(n1)
76 is2=iskew(n2)
77 IF(is1/=is2)THEN
78 CALL ancmsg(msgid=650,
79 . msgtype=msgerror,
80 . anmode=aninfo,
81 . i2=itab(n2),
82 . i1=itab(n1),
83 . i3=ixc(nixc,n))
84 END IF
85 CALL admbcs4(dir,icod,is1,n ,ixc,
86 . ipartc,ipart,icode,iskew,sh4tree)
87 END IF
88 END DO
89 END IF
90 END DO
91C
92 DO n=1,numeltg0
93 ip =iparttg(n)
94 nlev =ipart(10,ip)
95 IF(nlev>0)THEN
96 DO dir=0,2
97 n1=ixtg(dir+2,n)
98 n2=ixtg(mod(dir+1,3)+2,n)
99 ic1 =icode(n1)
100 ic2 =icode(n2)
101 icod=my_and(ic1,ic2)
102 IF(icod/=0)THEN
103 is1=iskew(n1)
104 is2=iskew(n2)
105 IF(is1/=is2)THEN
106 CALL ancmsg(msgid=650,
107 . msgtype=msgerror,
108 . anmode=aninfo,
109 . i2=itab(n2),
110 . i1=itab(n1),
111 . i3=ixtg(nixtg,n))
112 END IF
113 CALL admbcs3(dir,icod,is1,n ,ixtg,
114 . iparttg,ipart,icode,iskew,sh3tree)
115 END IF
116 END DO
117 END IF
118 END DO
119
120 RETURN
admbcs3
recursive subroutine admbcs3(dir, icod, isk, n, ixtg, iparttg, ipart, icode, iskew, sh3tree)
Definition admbcs.F:192
admbcs4
recursive subroutine admbcs4(dir, icod, isk, n, ixc, ipartc, ipart, icode, iskew, sh4tree)
Definition admbcs.F:133
message_mod
Definition message_mod.F:1257
my_and
int my_and(int *a, int *b)
Definition precision.c:54
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:895

◆ admbcs3()

recursive subroutine admbcs3 ( integer dir,
integer icod,
integer isk,
integer n,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) iparttg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 190 of file admbcs.F.

192 use element_mod , only : nixtg
193C-----------------------------------------------
194C I m p l i c i t T y p e s
195C-----------------------------------------------
196#include "implicit_f.inc"
197C-----------------------------------------------
198C G l o b a l P a r a m e t e r s
199C-----------------------------------------------
200#include "scr17_c.inc"
201#include "param_c.inc"
202C-----------------------------------------------
203C D u m m y A r g u m e n t s
204C-----------------------------------------------
205 INTEGER DIR,ICOD,ISK,N,IXTG(NIXTG,*),
206 . IPARTTG(*),IPART(LIPART1,*),ICODE(*),ISKEW(*),
207 . SH3TREE(KSH3TREE,*)
208C-----------------------------------------------
209C L o c a l V a r i a b l e s
210C-----------------------------------------------
211 INTEGER LEVEL,IP,NLEV
212 INTEGER SON, M1, M2
213C-----------------------------------------------
214 INTEGER MY_OR
215 EXTERNAL my_or
216C-----------------------------------------------
217 level=sh3tree(3,n)
218 IF(level<0)THEN
219 level=-(level+1)
220 END IF
221 ip =iparttg(n)
222 nlev =ipart(10,ip)
223
224 IF(level<nlev)THEN
225 son=sh3tree(2,n)+dir
226 CALL admbcs3(dir,icod,isk,son,ixtg,
227 . iparttg,ipart,icode,iskew,sh3tree)
228 son=sh3tree(2,n)+mod(dir+1,3)
229 CALL admbcs3(dir,icod,isk,son,ixtg,
230 . iparttg,ipart,icode,iskew,sh3tree)
231 ELSE
232 m1=ixtg(dir+2,n)
233 m2=ixtg(mod(dir+1,3)+2,n)
234 icode(m1)=my_or(icod,icode(m1))
235 icode(m2)=my_or(icod,icode(m2))
236 iskew(m1)=isk
237 iskew(m2)=isk
238 END IF
239
240 RETURN
my_or
int my_or(int *a, int *b)
Definition precision.c:63

◆ admbcs4()

recursive subroutine admbcs4 ( integer dir,
integer icod,
integer isk,
integer n,
integer, dimension(nixc,*) ixc,
integer, dimension(*) ipartc,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(ksh4tree,*) sh4tree )

Definition at line 131 of file admbcs.F.

133 use element_mod , only : nixc
134C-----------------------------------------------
135C I m p l i c i t T y p e s
136C-----------------------------------------------
137#include "implicit_f.inc"
138C-----------------------------------------------
139C G l o b a l P a r a m e t e r s
140C-----------------------------------------------
141#include "scr17_c.inc"
142#include "param_c.inc"
143C-----------------------------------------------
144C D u m m y A r g u m e n t s
145C-----------------------------------------------
146 INTEGER DIR,ICOD,ISK,N,IXC(NIXC,*),
147 . IPARTC(*),IPART(LIPART1,*),ICODE(*),ISKEW(*),
148 . SH4TREE(KSH4TREE,*)
149C-----------------------------------------------
150C L o c a l V a r i a b l e s
151C-----------------------------------------------
152 INTEGER LEVEL,IP,NLEV
153 INTEGER SON,M1,M2
154C-----------------------------------------------
155 INTEGER MY_OR
156 EXTERNAL my_or
157C-----------------------------------------------
158 level=sh4tree(3,n)
159 IF(level<0)THEN
160 level=-(level+1)
161 END IF
162 ip =ipartc(n)
163 nlev =ipart(10,ip)
164
165 IF(level<nlev)THEN
166 son=sh4tree(2,n)+dir
167 CALL admbcs4(dir,icod,isk,son,ixc,
168 . ipartc,ipart,icode,iskew,sh4tree)
169 son=sh4tree(2,n)+mod(dir+1,4)
170 CALL admbcs4(dir,icod,isk,son,ixc,
171 . ipartc,ipart,icode,iskew,sh4tree)
172 ELSE
173 m1=ixc(dir+2,n)
174 m2=ixc(mod(dir+1,4)+2,n)
175 icode(m1)=my_or(icod,icode(m1))
176 icode(m2)=my_or(icod,icode(m2))
177 iskew(m1)=isk
178 iskew(m2)=isk
179 END IF
180
181 RETURN