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
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
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
message_mod
Definition message_mod.F:1249
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:889

◆ 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 186 of file admbcs.F.

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
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 129 of file admbcs.F.

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