OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecbcscyc.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!|| hm_preread_bcscyc ../starter/source/constraints/general/bcs/lecbcscyc.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
32!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
33!|| ngr2usr ../starter/source/system/nintrr.F
34!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_preread_bcscyc(IGRNOD ,NOM_OPT ,LSUBMODEL,NBCSCYNN)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE groupdef_mod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "scr17_c.inc"
56#include "com04_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NBCSCYNN,NOM_OPT(LNOPT1,*)
61C INPUT ARGUMENTS
62 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
63C-----------------------------------------------
64 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,IGR1,IGR2,IGRS1,IGRS2,NBCS_CY_N,ID,SUB_INDEX
69 CHARACTER(LEN=NCHARKEY) :: KEY
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71 LOGICAL IS_AVAILABLE
72C-----------------------------------------------
73C E x t e r n a l F u n c t i o n s
74C-----------------------------------------------
75 INTEGER NGR2USR
76!
77 INTEGER, DIMENSION(:), POINTER :: INGR2USR
78C
79C======================================================================|
80C
81 is_available = .false.
82C
83 nbcs_cy_n = 0
84C--------------------------------------------------
85C START BROWSING MODEL /BCS
86C--------------------------------------------------
87 CALL hm_option_start('/BCS')
88C--------------------------------------------------
89C BROWSING MODEL PARTS 1->NBCS
90C--------------------------------------------------
91 DO i=1,numbcs
92 titr = ''
93C--------------------------------------------------
94C EXTRACT DATAS OF /BCS/... LINE
95C--------------------------------------------------
96 CALL hm_option_read_key(lsubmodel,
97 . option_id = id,
98 . option_titr = titr,
99 . submodel_index = sub_index,
100 . keyword2 = key)
101 IF (key(1:6) /= 'cyclic' ) CYCLE
102 NOM_OPT(1,I)=ID
103 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,I),LTITR)
104c
105 CALL HM_GET_INTV('grnd_id1',IGR1,IS_AVAILABLE,LSUBMODEL)
106 CALL HM_GET_INTV('grnd_id2',IGR2,IS_AVAILABLE,LSUBMODEL)
107 INGR2USR => IGRNOD(1:NGRNOD)%ID
108 IGRS1=NGR2USR(IGR1,INGR2USR,NGRNOD)
109 IGRS2=NGR2USR(IGR2,INGR2USR,NGRNOD)
110 IF (IGRS1==0) THEN
111 CALL ANCMSG(MSGID=678,ANMODE=ANINFO,MSGTYPE=MSGERROR,
112 . I1=ID,I2=IGR1,C1=TITR)
113 END IF
114 IF (IGRS2==0) THEN
115 CALL ANCMSG(MSGID=678,ANMODE=ANINFO,MSGTYPE=MSGERROR,
116 . I1=ID,I2=IGR2,C1=TITR)
117 END IF
118 IF (IGRNOD(IGRS1)%NENTITY /= IGRNOD(IGRS2)%NENTITY) THEN
119 CALL ANCMSG(MSGID=1753,ANMODE=ANINFO,MSGTYPE=MSGERROR,
120 . I1=ID,C1=TITR)
121 END IF
122 NBCS_CY_N = NBCS_CY_N + IGRNOD(IGRS1)%NENTITY
123 ENDDO
124 NBCSCYNN = 2*NBCS_CY_N
125C
126 RETURN
127 END
128!||====================================================================
129!|| ini_bcscyc ../starter/source/constraints/general/bcs/lecbcscyc.F
130!||--- called by ------------------------------------------------------
131!|| lectur ../starter/source/starter/lectur.F
132!||--- calls -----------------------------------------------------
133!|| ancmsg ../starter/source/output/message/message.F
134!|| inibcs_cy ../starter/source/constraints/general/bcs/lecbcscyc.F
135!||--- uses -----------------------------------------------------
136!|| message_mod ../starter/share/message_module/message_mod.F
137!||====================================================================
138 SUBROUTINE INI_BCSCYC(IBCSCYC,LBCSCYC,SKEW,X,ITAB,ICODE,IBFV,ITAGCYC)
139C-----------------------------------------------
140C M o d u l e s
141C-----------------------------------------------
142 USE MESSAGE_MOD
143C-----------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147C-----------------------------------------------
148C C o m m o n B l o c k s
149C-----------------------------------------------
150#include "param_c.inc"
151#include "com04_c.inc"
152C-----------------------------------------------
153C D u m m y A r g u m e n t s
154C-----------------------------------------------
155 INTEGER IBCSCYC(4,*),LBCSCYC(2,*),ITAB(*),ICODE(*),IBFV(NIFV,*),
156 . ITAGCYC(*)
157 my_real
158 . X(3,*),SKEW(LSKEW,*)
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162 INTEGER I, J ,ISK,IAD,NN,N1,N2,ID,ITAGIMP(NUMNOD),NF1,NF2,ICOOR
163C----- ini
164 DO I=1,NBCSCYC
165 IAD = IBCSCYC(1,I)+1
166 ISK = IBCSCYC(2,I)
167 NN = IBCSCYC(3,I)
168 ID = IBCSCYC(4,I)
169 CALL INIBCS_CY(NN,LBCSCYC(1,IAD),ISK,SKEW,X ,ITAB,ID)
170 END DO
171C------ ITAGCYC :ID for incompatibility check
172 ITAGCYC(1:NUMNOD) =0
173 DO I=1,NBCSCYC
174 IAD = IBCSCYC(1,I)
175 ISK = IBCSCYC(2,I)
176 NN = IBCSCYC(3,I)
177 DO J = 1,NN
178 N1 = LBCSCYC(1,IAD+J)
179 N2 = LBCSCYC(2,IAD+J)
180 ITAGCYC(N1) =ID
181 ITAGCYC(N2) =ID
182 END DO
183 END DO
184C----- check
185C-------BCS for the moment uncompatible
186 DO I=1,NBCSCYC
187 IAD = IBCSCYC(1,I)
188 ISK = IBCSCYC(2,I)
189 NN = IBCSCYC(3,I)
190 ID = IBCSCYC(4,I)
191 DO J = 1,NN
192 N1 = LBCSCYC(1,IAD+J)
193 N2 = LBCSCYC(2,IAD+J)
194 IF (ICODE(N1) >= 512 ) THEN
195 CALL ANCMSG(MSGID=1749,ANMODE=ANINFO,MSGTYPE=MSGERROR,
196 . I1=ID,I2=ITAB(N1))
197 END IF
198 IF (ICODE(N2) >= 512 ) THEN
199 CALL ANCMSG(MSGID=1750,ANMODE=ANINFO,MSGTYPE=MSGERROR,
200 . I1=ID,I2=ITAB(N2))
201 END IF
202 END DO
203 END DO
204C-------/IMPDIS,IMPVEL,IMPACC
205 ITAGIMP(1:NUMNOD)=0
206 DO J=1,NFXVEL
207 N1 =IABS(IBFV(1,J))
208 ISK = IBFV(2,J)/10
209 ICOOR = IBFV(10,J)
210 IF (ITAGIMP(N1)==0) THEN
211 IF (ICOOR==1) THEN
212 ITAGIMP(N1) = ISK
213 ELSE
214 ITAGIMP(N1) = -ISK
215 END IF
216 ELSE
217.AND. IF (ICOOR==1 ITAGIMP(N1) == ISK) THEN
218 ELSE
219 ITAGIMP(N1) = -ISK
220 END IF
221 END IF
222 ENDDO
223C
224 DO I=1,NBCSCYC
225 IAD = IBCSCYC(1,I)
226 ISK = IBCSCYC(2,I)
227 NN = IBCSCYC(3,I)
228 ID = IBCSCYC(4,I)
229 DO J = 1,NN
230 N1 = LBCSCYC(1,IAD+J)
231 N2 = LBCSCYC(2,IAD+J)
232 NF1 = ITAGIMP(N1)
233 NF2 = ITAGIMP(N2)
234C------ok for NF1=0,NF2=0; NF1=NF2=ISK
235 IF (NF1==NF2) THEN
236.OR. IF (NF1==0NF1==ISK) THEN
237 ELSE
238 CALL ANCMSG(MSGID=1751,ANMODE=ANINFO,MSGTYPE=MSGERROR,
239 . I1=ID ,I2=ITAB(N1),I3=ITAB(N2))
240 END IF
241 ELSE
242 CALL ANCMSG(MSGID=1752,ANMODE=ANINFO,MSGTYPE=MSGERROR,
243 . I1=ID ,I2=ITAB(N1),I3=ITAB(N2))
244 END IF
245 END DO
246 END DO
247C
248 RETURN
249 END SUBROUTINE INI_BCSCYC
250!||====================================================================
251!|| inibcs_cy ../starter/source/constraints/general/bcs/lecbcscyc.F
252!||--- called by ------------------------------------------------------
253!|| ini_bcscyc ../starter/source/constraints/general/bcs/lecbcscyc.F
254!||--- calls -----------------------------------------------------
255!|| ancmsg ../starter/source/output/message/message.F
256!|| car2cylin ../starter/source/constraints/general/bcs/lecbcscyc.F
257!||--- uses -----------------------------------------------------
258!|| message_mod ../starter/share/message_module/message_mod.F
259!||====================================================================
260 SUBROUTINE INIBCS_CY(NBCY_N,IXCYCL,ISK,SKEW,X ,ITAB,ID)
261C-----------------------------------------------
262C M o d u l e s
263C-----------------------------------------------
264 USE MESSAGE_MOD
265C-----------------------------------------------
266C I m p l i c i t T y p e s
267C-----------------------------------------------
268#include "implicit_f.inc"
269C-----------------------------------------------
270C C o m m o n B l o c k s
271C-----------------------------------------------
272#include "param_c.inc"
273C-----------------------------------------------
274C D u m m y A r g u m e n t s
275C-----------------------------------------------
276 INTEGER NBCY_N,IXCYCL(2,*),ITAB(*),ISK,ID
277 my_real
278 . X(3,*),SKEW(LSKEW,*)
279C-----------------------------------------------
280C L o c a l V a r i a b l e s
281C-----------------------------------------------
282 INTEGER I, J ,N1(NBCY_N),N2(NBCY_N),INDEX(NBCY_N),IER1
283C
284 my_real
285 . CY_X1(3,NBCY_N), CY_X2(3,NBCY_N),DIS1(NBCY_N),DIS2(NBCY_N),LMIN,
286 . CY_TMP(3,NBCY_N),RI,ZI,TOL,ERR_TH,ERMAX
287C========================================================================|
288C-----for each cut-section nodes, compute cylindrical coordinates and dis
289 DO I=1,NBCY_N
290 N1(I) = IXCYCL(1,I)
291 N2(I) = IXCYCL(2,I)
292 ENDDO
293C-------5% error
294 ERR_TH=ZEP05
295 CALL CAR2CYLIN(NBCY_N,N1,X,CY_X1,DIS1,
296 . SKEW(1,ISK),SKEW(10,ISK),ERR_TH,IER1)
297c--------check (r,cos(theta),z), cos(theta) not too diff
298 IF (IER1<0 ) THEN
299 CALL ANCMSG(MSGID=1761,ANMODE=ANINFO,MSGTYPE=MSGERROR,I1=ID)
300 END IF
301C------sorting by dis
302 CALL MYQSORT(NBCY_N, DIS1, INDEX, IER1)
303 CY_TMP(1:3,1:NBCY_N) = CY_X1(1:3,1:NBCY_N)
304 DO I=1,NBCY_N
305 J = INDEX(I)
306 N1(I) = IXCYCL(1,J)
307 CY_X1(1:3,I)=CY_TMP(1:3,J)
308 ENDDO
309 LMIN = EP20
310 DO I=2,NBCY_N
311 RI = ABS(CY_X1(1,I)-CY_X1(1,I-1))
312 ZI = ABS(CY_X1(3,I)-CY_X1(3,I-1))
313 LMIN =MIN(LMIN,MAX(RI,ZI))
314 ENDDO
315 CALL CAR2CYLIN(NBCY_N,N2,X,CY_X2,DIS2,
316 . SKEW(1,ISK),SKEW(10,ISK),ERR_TH,IER1)
317c--------check (r,cos(theta),z), cos(theta) not too diff
318 IF (IER1<0 ) THEN
319 CALL ANCMSG(MSGID=1762,ANMODE=ANINFO,MSGTYPE=MSGERROR,I1=ID)
320 END IF
321C------sorting by dis
322 CALL MYQSORT(NBCY_N, DIS2, INDEX, IER1)
323 CY_TMP(1:3,1:NBCY_N) = CY_X2(1:3,1:NBCY_N)
324 DO I=1,NBCY_N
325 J = INDEX(I)
326 N2(I) = IXCYCL(2,J)
327 CY_X2(1:3,I)=CY_TMP(1:3,J)
328 ENDDO
329 DO I=2,NBCY_N
330 RI = ABS(CY_X2(1,I)-CY_X2(1,I-1))
331 ZI = ABS(CY_X2(3,I)-CY_X2(3,I-1))
332 LMIN =MIN(LMIN,MAX(RI,ZI))
333 ENDDO
334 TOL = LMIN*ERR_TH
335 ERMAX = ZERO
336 J = 1
337 DO I=1,NBCY_N
338 RI = ABS(CY_X2(1,I)-CY_X1(1,I))
339 ZI = ABS(CY_X2(3,I)-CY_X1(3,I))
340 LMIN =MAX(RI,ZI)
341 IF (LMIN>ERMAX) THEN
342 ERMAX=LMIN
343 J = I
344 END IF
345 ENDDO
346 IF (ERMAX>TOL ) THEN
347 CALL ANCMSG(MSGID=1763,ANMODE=ANINFO,MSGTYPE=MSGERROR,
348 . I1=ID,I2=ITAB(N1(J)),I3=ITAB(N2(J)))
349 END IF
350 DO I=1,NBCY_N
351 IXCYCL(1,I) = N1(I)
352 IXCYCL(2,I) = N2(I)
353 ENDDO
354C
355 RETURN
356 END SUBROUTINE INIBCS_CY
357!||====================================================================
358!|| car2cylin ../starter/source/constraints/general/bcs/lecbcscyc.F
359!||--- called by ------------------------------------------------------
360!|| inibcs_cy ../starter/source/constraints/general/bcs/lecbcscyc.F
361!||====================================================================
362 SUBROUTINE CAR2CYLIN(NBCY_N,IX,X,CY_X,DIS,SKEW,XYZ0,TOL,IER)
363C-----------------------------------------------
364C I m p l i c i t T y p e s
365C-----------------------------------------------
366#include "implicit_f.inc"
367C-----------------------------------------------
368C D u m m y A r g u m e n t s
369C-----------------------------------------------
370 INTEGER NBCY_N,IX(*),IER
371 my_real
372 . X(3,*),SKEW(9),XYZ0(3),CY_X(3,*),DIS(*),TOL
373C-----------------------------------------------
374C L o c a l V a r i a b l e s
375C-----------------------------------------------
376 INTEGER I
377 my_real XX,YY,ZZ,XL,YL,ZL,R2,TH_MEAN,TH_MAX,ZL_MIN
378C========================================================================|
379C----- compute cylindrical coordinates(r,cos(theta),z) and dis=r*r+z*z
380 TH_MEAN =ZERO
381 ZL_MIN = EP20
382 DO I=1,NBCY_N
383 XX = X(1,IX(I))-XYZ0(1)
384 YY = X(2,IX(I))-XYZ0(2)
385 ZZ = X(3,IX(I))-XYZ0(3)
386 XL = XX*SKEW(1)+YY*SKEW(2)+ZZ*SKEW(3)
387 YL = XX*SKEW(4)+YY*SKEW(5)+ZZ*SKEW(6)
388 ZL = XX*SKEW(7)+YY*SKEW(8)+ZZ*SKEW(9)
389 R2 = XL*XL+YL*YL
390 CY_X(1,I) = SQRT(R2)
391 CY_X(2,I) = XL/CY_X(1,I)
392 CY_X(3,I) = ZL
393 DIS(I) = R2
394 TH_MEAN = TH_MEAN + CY_X(2,I)
395 ZL_MIN = MIN(ZL_MIN,ZL)
396 ENDDO
397 DO I=1,NBCY_N
398 CY_X(3,I) = CY_X(3,I)-ZL_MIN
399 DIS(I) = DIS(I) + CY_X(3,I)*CY_X(3,I)
400 ENDDO
401 TH_MEAN =TH_MEAN/NBCY_N
402 IER = 0
403 TH_MAX =ZERO
404 DO I=1,NBCY_N
405 TH_MAX = MAX(TH_MAX,ABS(CY_X(2,I)-TH_MEAN))
406 ENDDO
407c print *,'TH_MAX,TH_MEAN=',TH_MAX,TH_MEAN
408 IF (TH_MAX>TOL*ABS(TH_MEAN)) IER = -1
409C--- numeric
410 IF (TH_MAX<EM6) IER = 0
411C
412 RETURN
413 END SUBROUTINE CAR2CYLIN
414!||====================================================================
415!|| int2cy_chk ../starter/source/constraints/general/bcs/lecbcscyc.F
416!||--- called by ------------------------------------------------------
417!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
418!||--- calls -----------------------------------------------------
419!|| ancmsg ../starter/source/output/message/message.F
420!|| intab ../starter/source/interfaces/inter3d1/i24tools.F
421!||--- uses -----------------------------------------------------
422!|| message_mod ../starter/share/message_module/message_mod.F
423!||====================================================================
424 SUBROUTINE INT2CY_CHK(IPARI,INTBUF_TAB,ITAGCYC,ITAB)
425C-----------------------------------------------
426C M o d u l e s
427C-----------------------------------------------
428 USE MESSAGE_MOD
429 USE INTBUFDEF_MOD
430 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
431C-----------------------------------------------
432C I m p l i c i t T y p e s
433C-----------------------------------------------
434#include "implicit_f.inc"
435C-----------------------------------------------
436C C o m m o n B l o c k s
437C-----------------------------------------------
438#include "param_c.inc"
439#include "com04_c.inc"
440C-----------------------------------------------
441C D u m m y A r g u m e n t s
442C-----------------------------------------------
443 INTEGER IPARI(NPARI,NINTER),ITAGCYC(*),ITAB(*)
444 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
445C-----------------------------------------------
446C External function
447C-----------------------------------------------
448 LOGICAL INTAB
449 EXTERNAL INTAB
450C-----------------------------------------------
451C L o c a l V a r i a b l e s
452C-----------------------------------------------
453 INTEGER I,N,NTY,NSN,ISL,NOINT
454 INTEGER ILEV
455C=======================================================================
456 DO N=1,NINTER
457 NTY = IPARI(7,N)
458 IF (NTY == 2 ) THEN
459 NSN = IPARI(5,N)
460 ILEV = IPARI(20,N)
461 NOINT = IPARI(15,N)
462C----------only kinematic ones
463.AND. IF (ILEV >= 25 ILEV <= 28) CYCLE
464 DO I=1,NSN
465 ISL = INTBUF_TAB(N)%NSV(I)
466 IF (ITAGCYC(ISL)/=0) THEN
467 CALL ANCMSG(MSGID=1758,ANMODE=ANINFO,MSGTYPE=MSGERROR,
468 . I1=ITAGCYC(ISL),I2=ITAB(ISL),I3=NOINT)
469 END IF
470 END DO
471 END IF
472 END DO
473C
474c-----------
475 RETURN
476 END SUBROUTINE INT2CY_CHK
477C kinchk
478C 2) partial incompatible : impvel (same between n1,n2 with icoord=1)
479C 3) special case : bcs now:1) future :2)
480C 4) remove ND of NS10E at NS10E side
481C nspmd>1 : n1,n2 in the same domain
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
hm_preread_bcscyc
subroutine hm_preread_bcscyc(igrnod, nom_opt, lsubmodel, nbcscynn)
Definition lecbcscyc.F:40
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
submodel_mod::submodel_data
Definition submodel_mod.F:723