OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcsdtth.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/.
23Ch
24!||====================================================================
25!|| bcsdtth ../engine/source/constraints/general/bcs/bcsdtth.F
26!||--- uses -----------------------------------------------------
27!|| message_mod ../engine/share/message_module/message_mod.F
28!||====================================================================
29 SUBROUTINE bcsdtth(ICODT,ICODR,KINET,ITAB,LPBY,NPBY)
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
208 END
209
210C-------------------------------------------------------------------------------------
211Ch
212!||====================================================================
213!|| bcsdtth_copy ../engine/source/constraints/general/bcs/bcsdtth.F
214!||--- called by ------------------------------------------------------
215!|| resol ../engine/source/engine/resol.F
216!||====================================================================
217 SUBROUTINE BCSDTTH_COPY(ICODT, ICODR, ICODT0, ICODR0,IFLAG)
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
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
267 END
268
bcsdtth
subroutine bcsdtth(icodt, icodr, kinet, itab, lpby, npby)
Definition bcsdtth.F:30
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
message_mod
Definition message_mod.F:1257
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29