OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcscyc.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!|| bcscyc ../engine/source/constraints/general/bcs/bcscyc.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| acc_cycon ../engine/source/constraints/general/bcs/bcscyc.F
29!|| chkv0_cy ../engine/source/constraints/general/bcs/bcscyc.F
30!||====================================================================
31 SUBROUTINE bcscyc(IBCSCYC,LBCSCYC,SKEW,X,V,A,ITAB)
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 "com01_c.inc"
40#include "com04_c.inc"
41#include "param_c.inc"
42#include "sms_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IBCSCYC(4,*),LBCSCYC(2,*),ITAB(*)
47 my_real
48 . x(3,*),v(3,*),a(3,*),skew(lskew,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I, J ,ISK,IAD,NN,N1,N2,ID
53 my_real
54 . ax, ay, az
55C-----------------------------------------------
56C---Check Ncycle=0 V(,N1)=V(,N2) in c.s.
57 IF (ncycle==0) THEN
58 DO i=1,nbcscyc
59 iad = ibcscyc(1,i)+1
60 isk = ibcscyc(2,i)
61 nn = ibcscyc(3,i)
62 id = ibcscyc(4,i)
63 CALL chkv0_cy(nn,lbcscyc(1,iad),isk,skew,x ,v,id,itab)
64 END DO
65 END IF
66C----case AMS done before in sms_pcg
67 IF(idtmins == 2.OR.idtmins_int /= 0) RETURN
68 DO i=1,nbcscyc
69 iad = ibcscyc(1,i)+1
70 isk = ibcscyc(2,i)
71 nn = ibcscyc(3,i)
72 id = ibcscyc(4,i)
73 CALL acc_cycon(nn,lbcscyc(1,iad),isk,skew,x ,a)
74 END DO
75C
76 RETURN
77 END
78!||====================================================================
79!|| acc_cycon ../engine/source/constraints/general/bcs/bcscyc.F
80!||--- called by ------------------------------------------------------
81!|| bcscyc ../engine/source/constraints/general/bcs/bcscyc.F
82!|| sms_bcscyc ../engine/source/ams/sms_bcscyc.F
83!||--- calls -----------------------------------------------------
84!|| v_c2cylin ../engine/source/constraints/general/bcs/bcscyc.F
85!|| v_cyc2c ../engine/source/constraints/general/bcs/bcscyc.F
86!||--- uses -----------------------------------------------------
87!|| message_mod ../engine/share/message_module/message_mod.F
88!||====================================================================
89 SUBROUTINE acc_cycon(NBCY_N,IXCYCL,ISK,SKEW,X ,A)
90C-----------------------------------------------
91C M o d u l e s
92C-----------------------------------------------
93 USE message_mod
94C-----------------------------------------------
95C I m p l i c i t T y p e s
96C-----------------------------------------------
97#include "implicit_f.inc"
98C-----------------------------------------------
99C C o m m o n B l o c k s
100C-----------------------------------------------
101#include "param_c.inc"
102C-----------------------------------------------
103C D u m m y A r g u m e n t s
104C-----------------------------------------------
105 INTEGER NBCY_N,IXCYCL(2,*),ISK
106 my_real
107 . x(3,*),a(3,*),skew(lskew,*)
108C-----------------------------------------------
109C L o c a l V a r i a b l e s
110C-----------------------------------------------
111 INTEGER I, J ,N1(NBCY_N),N2(NBCY_N)
112C
113 my_real
114 . ccos1(nbcy_n),csin1(nbcy_n),ccos2(nbcy_n),csin2(nbcy_n),
115 . a_c1(3,nbcy_n),a_c2(3,nbcy_n),a_c(3,nbcy_n)
116C========================================================================|
117C---- for each section nodes :
118C-------A (SKEW) -> A'(x',y',z')->A"(r,dthe,z')
119C--- mean(A")-> A'(x',y',z')->A (SKEW^t)
120 DO i=1,nbcy_n
121 n1(i) = ixcycl(1,i)
122 n2(i) = ixcycl(2,i)
123 ENDDO
124 CALL v_c2cylin(nbcy_n,n1,x,a,skew(1,isk),skew(10,isk),ccos1,csin1,a_c1)
125 CALL v_c2cylin(nbcy_n,n2,x,a,skew(1,isk),skew(10,isk),ccos2,csin2,a_c2)
126 a_c(1:3,1:nbcy_n) = half*(a_c1(1:3,1:nbcy_n)+a_c2(1:3,1:nbcy_n))
127 CALL v_cyc2c(nbcy_n,skew(1,isk),ccos1,csin1,a_c,a_c1)
128 CALL v_cyc2c(nbcy_n,skew(1,isk),ccos2,csin2,a_c,a_c2)
129 DO i=1,nbcy_n
130 a(1:3,n1(i)) = a_c1(1:3,i)
131 a(1:3,n2(i)) = a_c2(1:3,i)
132 ENDDO
133C
134 RETURN
135 END
136!||====================================================================
137!|| v_c2cylin ../engine/source/constraints/general/bcs/bcscyc.F
138!||--- called by ------------------------------------------------------
139!|| acc_cycon ../engine/source/constraints/general/bcs/bcscyc.F
140!|| chkv0_cy ../engine/source/constraints/general/bcs/bcscyc.F
141!||====================================================================
142 SUBROUTINE v_c2cylin(NBCY,IX,X,V,SKEW,XYZ0,CCOS,CSIN,V_C)
143C-----------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147C-----------------------------------------------
148C D u m m y A r g u m e n t s
149C-----------------------------------------------
150 INTEGER NBCY,IX(*)
151 my_real
152 . x(3,*),skew(9),xyz0(3),v(3,*),
153 . v_c(3,nbcy),ccos(nbcy),csin(nbcy)
154C-----------------------------------------------
155C L o c a l V a r i a b l e s
156C-----------------------------------------------
157 INTEGER I, J
158C
159 my_real
160 . xx,yy,zz,xl,yl,zl,r2,cr(nbcy),cz(nbcy)
161C========================================================================|
162C----- compute v to v_cylin
163 DO i=1,nbcy
164 xx = x(1,ix(i))-xyz0(1)
165 yy = x(2,ix(i))-xyz0(2)
166 zz = x(3,ix(i))-xyz0(3)
167 xl = xx*skew(1)+yy*skew(2)+zz*skew(3)
168 yl = xx*skew(4)+yy*skew(5)+zz*skew(6)
169 zl = xx*skew(7)+yy*skew(8)+zz*skew(9)
170 r2 = xl*xl+yl*yl
171 cr(i) = sqrt(r2)
172 ccos(i) = xl/cr(i)
173 csin(i) = yl/cr(i)
174 cz(i) = zl
175 ENDDO
176 DO i=1,nbcy
177 xx = v(1,ix(i))
178 yy = v(2,ix(i))
179 zz = v(3,ix(i))
180 xl = xx*skew(1)+yy*skew(2)+zz*skew(3)
181 yl = xx*skew(4)+yy*skew(5)+zz*skew(6)
182 zl = xx*skew(7)+yy*skew(8)+zz*skew(9)
183 v_c(1,i) = xl*ccos(i)+yl*csin(i)
184 v_c(2,i) = yl*ccos(i)-xl*csin(i)
185 v_c(3,i) = zl
186 ENDDO
187C
188 RETURN
189 END SUBROUTINE v_c2cylin
190!||====================================================================
191!|| v_cyc2c ../engine/source/constraints/general/bcs/bcscyc.F
192!||--- called by ------------------------------------------------------
193!|| acc_cycon ../engine/source/constraints/general/bcs/bcscyc.F
194!||====================================================================
195 SUBROUTINE v_cyc2c(NBCY,SKEW,CCOS,CSIN,V_C,VC)
196C-----------------------------------------------
197C I m p l i c i t T y p e s
198C-----------------------------------------------
199#include "implicit_f.inc"
200C-----------------------------------------------
201C D u m m y A r g u m e n t s
202C-----------------------------------------------
203 INTEGER NBCY
204 my_real
205 . skew(9),v_c(3,nbcy),ccos(nbcy),csin(nbcy),vc(3,nbcy)
206C-----------------------------------------------
207C L o c a l V a r i a b l e s
208C-----------------------------------------------
209 INTEGER I, J
210C
211 my_real
212 . xx,yy,zz,xl,yl,zl
213C========================================================================|
214C----- compute v_cylin to v
215 DO i=1,nbcy
216 xx = v_c(1,i)*ccos(i)-v_c(2,i)*csin(i)
217 yy = v_c(1,i)*csin(i)+v_c(2,i)*ccos(i)
218 zz = v_c(3,i)
219 xl = xx*skew(1)+yy*skew(4)+zz*skew(7)
220 yl = xx*skew(2)+yy*skew(5)+zz*skew(8)
221 zl = xx*skew(3)+yy*skew(6)+zz*skew(9)
222 vc(1,i) = xl
223 vc(2,i) = yl
224 vc(3,i) = zl
225 ENDDO
226C
227 RETURN
228 END SUBROUTINE v_cyc2c
229!||====================================================================
230!|| chkv0_cy ../engine/source/constraints/general/bcs/bcscyc.F
231!||--- called by ------------------------------------------------------
232!|| bcscyc ../engine/source/constraints/general/bcs/bcscyc.F
233!||--- calls -----------------------------------------------------
234!|| ancmsg ../engine/source/output/message/message.F
235!|| v_c2cylin ../engine/source/constraints/general/bcs/bcscyc.F
236!||--- uses -----------------------------------------------------
237!|| message_mod ../engine/share/message_module/message_mod.F
238!||====================================================================
239 SUBROUTINE chkv0_cy(NBCY_N,IXCYCL,ISK,SKEW,X ,V ,ID ,ITAB)
240C-----------------------------------------------
241C M o d u l e s
242C-----------------------------------------------
243 USE message_mod
244C-----------------------------------------------
245C I m p l i c i t T y p e s
246C-----------------------------------------------
247#include "implicit_f.inc"
248C-----------------------------------------------
249C C o m m o n B l o c k s
250C-----------------------------------------------
251#include "param_c.inc"
252C-----------------------------------------------
253C D u m m y A r g u m e n t s
254C-----------------------------------------------
255 INTEGER NBCY_N,IXCYCL(2,*),ISK,ID,ITAB(*)
256 my_real
257 . x(3,*),v(3,*),skew(lskew,*)
258C-----------------------------------------------
259C L o c a l V a r i a b l e s
260C-----------------------------------------------
261 INTEGER I, J ,N1(NBCY_N),N2(NBCY_N) ,II1,II2
262C
263 my_real
264 . ccos(nbcy_n),csin(nbcy_n),v_c1(3,nbcy_n),v_c2(3,nbcy_n),
265 . dv,dvmax,dvmean
266C========================================================================|
267C-----for each cut-section nodes, compute cylindrical coordinates and vel
268 DO i=1,nbcy_n
269 n1(i) = ixcycl(1,i)
270 n2(i) = ixcycl(2,i)
271 ENDDO
272 CALL v_c2cylin(nbcy_n,n1,x,v,skew(1,isk),skew(10,isk),ccos,csin,v_c1)
273 CALL v_c2cylin(nbcy_n,n2,x,v,skew(1,isk),skew(10,isk),ccos,csin,v_c2)
274C--- check
275 dvmax =zero
276 j =1
277 dvmean =zero
278 DO i=1,nbcy_n
279 dv = abs(v_c1(2,i)-v_c2(2,i))
280 IF (dv >dvmax) THEN
281 dvmax = dv
282 j = i
283 END IF
284 dvmean =dvmean + abs(v_c1(2,i))+abs(v_c2(2,i))
285 ENDDO
286 IF (nbcy_n>0) dvmean =half*dvmean/nbcy_n
287 IF (dvmax>zep05*dvmean.AND.dvmean>em06) THEN
288 ii1 = itab(n1(j))
289 ii2 = itab(n2(j))
290 CALL ancmsg(msgid=285,anmode=aninfo,i1=id,i2=ii1,i3=ii2)
291 END IF
292C
293 RETURN
294 END
v_c2cylin
subroutine v_c2cylin(nbcy, ix, x, v, skew, xyz0, ccos, csin, v_c)
Definition bcscyc.F:143
bcscyc
subroutine bcscyc(ibcscyc, lbcscyc, skew, x, v, a, itab)
Definition bcscyc.F:32
chkv0_cy
subroutine chkv0_cy(nbcy_n, ixcycl, isk, skew, x, v, id, itab)
Definition bcscyc.F:240
v_cyc2c
subroutine v_cyc2c(nbcy, skew, ccos, csin, v_c, vc)
Definition bcscyc.F:196
acc_cycon
subroutine acc_cycon(nbcy_n, ixcycl, isk, skew, x, a)
Definition bcscyc.F:90
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1249
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