OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcsdtth.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "kincod_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine bcsdtth (icodt, icodr, kinet, itab, lpby, npby)
subroutine bcsdtth_copy (icodt, icodr, icodt0, icodr0, iflag)

Function/Subroutine Documentation

◆ bcsdtth()

subroutine bcsdtth ( integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) kinet,
integer, dimension(*) itab,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby )

Definition at line 29 of file bcsdtth.F.

30 USE message_mod
31C
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com04_c.inc"
40#include "units_c.inc"
41#include "param_c.inc"
42#include "kincod_c.inc"
43C-----------------------------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER ICODT(*),ICODR(*),ITAB(*),KINET(*),NPBY(NNPBY,*),LPBY(*)
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I,J, N, NSLRB,JWARN1,JWARN2
51 INTEGER IK(9), NK(9,NUMNOD),NKK
52C
53C=======================================================================
54
55 jwarn1 = 0
56 jwarn2 = 0
57 ik(1:9) = 0
58 nk(1:9,1:numnod) = 0
59 i = -huge(i)
60 DO n=1,numnod
61 IF(icodt(n)/=7.OR.icodr(n)/=7) THEN
62
63 IF(irb(kinet(n))==0) THEN
64 jwarn1 = jwarn1 + 1
65 ik(1) = ik(1) + 1
66 nk(1,jwarn1) = itab(n)
67 ELSE
68 DO i=1,nrbody
69 nslrb = npby(2,i)
70 DO j=1,nslrb
71 IF(lpby(j)==n)THEN
72 IF(icodt(npby(1,i))/=7.OR.icodr(npby(1,i))/=7) THEN
73 jwarn1 = jwarn1 + 1
74 ik(1) = ik(1) + 1
75 nk(1,jwarn1) = itab(npby(1,i))
76 ENDIF
77 ENDIF
78 ENDDO
79 ENDDO
80
81 ENDIF
82 ELSE
83 !bug here? is the value of I correct?
84 nkk=itf(kinet(n))+irb(kinet(n))+irb2(kinet(n))+irbm(kinet(n))+
85 . iwl(kinet(i))+ivf(kinet(i))+irv(kinet(i))+ijo(kinet(i))+
86 . irlk(kinet(i))
87
88 IF(nkk>=1) THEN
89 jwarn2 = jwarn2 + 1
90 IF(itf(kinet(n))/= 0) THEN
91 ik(2) = ik(2) + 1
92 j = ik(2)
93 nk(2,j) = itab(n)
94 ELSEIF(irb(kinet(n))/= 0) THEN
95 ik(3) = ik(3) + 1
96 j = ik(3)
97 nk(3,j) = itab(n)
98 ELSEIF(irb2(kinet(n))/= 0) THEN
99 ik(3) = ik(3) + 1
100 j = ik(3)
101 nk(3,j) = itab(n)
102 ELSEIF(irbm(kinet(n))/= 0)THEN
103 ik(4) = ik(4) + 1
104 j = ik(4)
105 nk(4,j) = itab(n)
106 ELSEIF (iwl(kinet(i))/= 0)THEN
107 ik(5) = ik(5) + 1
108 j = ik(5)
109 nk(5,j) = itab(n)
110 ELSEIF (ivf(kinet(i))/= 0)THEN
111 ik(6) = ik(6) + 1
112 j = ik(6)
113 nk(6,j) = itab(n)
114 ELSEIF (irv(kinet(i))/= 0)THEN
115 ik(7) = ik(7) + 1
116 j = ik(7)
117 nk(7,j) = itab(n)
118 ELSEIF (ijo(kinet(i))/= 0)THEN
119 ik(8) = ik(8) + 1
120 j = ik(8)
121 nk(8,j) = itab(n)
122 ELSEIF (irlk(kinet(i))/= 0)THEN
123 ik(9) = ik(9) + 1
124 j = ik(9)
125 nk(9,j) = itab(n)
126 ENDIF
127
128 ENDIF
129
130 ENDIF
131
132 ENDDO
133C
134 IF(jwarn1/=0)THEN
135 WRITE(iout,'(A,A)')
136 . ' ** WARNING : THERMAL TIME STEP CALCULATION',
137 . ' THESE NODES MUST BE BLOCKED'
138 WRITE(iout,*) nk(1,1:ik(1))
139
140 WRITE(istdo,'(A,A,I10,A)')
141 . ' ** WARNING : THERMAL TIME STEP CALCULATION',
142 . ' NODE(S) MUST BE BLOCKED',
143 . jwarn1,'WARNING(S)'
144 ENDIF
145
146 IF(jwarn2/=0)THEN
147 WRITE(iout,'(A,A)')
148 .'** WARNING : THERMAL TIME STEP CALCULATION
149 . POSSIBLE INCOMPATIBLE CONDITION(S)'
150! WRITE(ISTDO,'(A,A,I10,A)')
151! .'** WARNING : THERMAL TIME STEP CALCULATION'
152! .' POSSIBLE INCOMPATIBLE CONDITION(S)',
153! . JWARN2,'WARNING(S)'
154 WRITE(istdo, 1000) jwarn2
155 IF(ik(2)/= 0) THEN
156 WRITE(iout,'(A)')
157 . ' - INTERFACE TYPE 1 2 OR 9 FOR NODES : '
158 WRITE(iout,*) nk(2,1:ik(2))
159
160 ELSEIF(ik(3)/= 0) THEN
161 WRITE(iout,'(A)')
162 . ' - RIGID BODY FOR NODES'
163 WRITE(iout,*) nk(3,1:ik(3))
164
165 ELSEIF(ik(4)/= 0)THEN
166 WRITE(iout,*)
167 . ' - IMPOSED BODY VELOCITY FOR NODES : '
168 WRITE(iout,*) nk(4,1:ik(4))
169
170 ELSEIF (ik(5)/= 0)THEN
171 WRITE(iout,*)
172 . ' - RIGID WALL FOR NODES'
173 WRITE(iout,*) nk(5,1:ik(5))
174
175 ELSEIF (ik(6)/= 0)THEN
176 WRITE(iout,*)
177 . ' - IMPOSED ACCELERATION, IMPOSED DISPLACEMENT
178 . , IMPOSED VELOCITY FOR NODES : '
179 WRITE(iout,*) nk(6,1:ik(6))
180
181 WRITE(istdo,*)
182 . ' - IMPOSED ACCELERATION, IMPOSED DISPLACEMENT
183 . , IMPOSED VELOCITY FOR NODES'
184 WRITE(istdo,*) nk(6,1:ik(6))
185
186 ELSEIF (ik(7)/= 0)THEN
187 WRITE(iout,*)
188 . ' - RIVET FOR NODES'
189 WRITE(iout,*) nk(7,1:ik(7))
190
191 ELSEIF (ik(8)/= 0)THEN
192 WRITE(iout,*)
193 . ' - CYLINDRICAL JOINT FOR NODES : '
194 WRITE(iout,*) nk(8,1:ik(8))
195
196 ELSEIF (irlk(kinet(i))/= 0)THEN
197 WRITE(iout,*)
198 . ' - RIGID LINK FOR NODES : '
199 WRITE(iout,*) nk(9,1:ik(9))
200
201 ENDIF
202 ENDIF
203
204
205 1000 FORMAT(1x,'** WARNING : THERMAL TIME STEP CALCULATION POSSIBLE INCOMPATIBLE CONDITION(S)',i10,1x,'WARNING(S)')
206
207 RETURN
message_mod
Definition message_mod.F:1249

◆ bcsdtth_copy()

subroutine bcsdtth_copy ( integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) icodt0,
integer, dimension(*) icodr0,
integer iflag )

Definition at line 217 of file bcsdtth.F.

218C
219C-----------------------------------------------
220C I m p l i c i t T y p e s
221C-----------------------------------------------
222#include "implicit_f.inc"
223C-----------------------------------------------
224C C o m m o n B l o c k s
225C-----------------------------------------------
226#include "com01_c.inc"
227#include "com04_c.inc"
228C-----------------------------------------------------------------
229C D u m m y A r g u m e n t s
230C-----------------------------------------------
231 INTEGER IFLAG,
232 . ICODT(*),ICODR(*),ICODT0(*),ICODR0(*)
233C-----------------------------------------------
234C L o c a l V a r i a b l e s
235C-----------------------------------------------
236 INTEGER N, NG, IG, ITY
237C
238C=======================================================================
239 IF(iflag==1) THEN ! copy initial Boundary conditions into temporal tab and constraint DDLS
240 IF(iroddl>0)THEN
241 DO n=1,numnod
242 icodt0(n) =icodt(n)
243 icodr0(n) =icodr(n)
244 icodt(n) =7
245 icodr(n) =7
246 ENDDO
247 ELSE
248 DO n=1,numnod
249 icodt0(n) =icodt(n)
250 icodt(n) =7
251 ENDDO
252 ENDIF
253
254 ELSE ! Recopy initial Boundary conditions before end
255 IF(iroddl>0)THEN
256 DO n=1,numnod
257 icodt(n) =icodt0(n)
258 icodr(n) =icodr0(n)
259 ENDDO
260 ELSE
261 DO n=1,numnod
262 icodt(n) =icodt0(n)
263 ENDDO
264 ENDIF
265 ENDIF
266 RETURN