OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
leccut.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!|| leccut ../engine/source/tools/sect/leccut.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.f
27!||--- calls -----------------------------------------------------
28!|| sysfus ../engine/source/system/sysfus.F
29!||====================================================================
30 SUBROUTINE leccut(ICUT,XCUT,ITABM1)
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C D u m m y A r g u m e n t s
37C-----------------------------------------------
38 INTEGER ICUT(44,*),ITABM1(*)
39 my_real xcut(7,*)
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44#include "units_c.inc"
45#include "scrcut_c.inc"
46C-----------------------------------------------
47C L o c a l V a r i a b l e s
48C-----------------------------------------------
49 INTEGER I,J,ITYP
50 my_real x0(3),vn(3),vit,vnn
51 CHARACTER IDTITL*40
52C-----------------------------------------------
53C E x t e r n a l F u n c t i o n s
54C-----------------------------------------------
55 my_real, EXTERNAL :: sysfus
56C-----------------------------------------------
57 WRITE(iout,2000)ncuts
58 DO i=1,ncuts
59 READ(iin,'(I8,A40)')ityp,idtitl
60 IF(ityp==0)ityp=1
61 WRITE(iout,1100)idtitl,ityp
62 icut(1,i)=ityp
63 DO j=1,40
64 icut(4+j,i) = ichar(idtitl(j:j))
65 ENDDO
66 IF(ityp<3)THEN
67 READ(iin,'(7E16.0)')(x0(j),j=1,3),(vn(j),j=1,3),vit
68 IF(ityp==2)vit=0
69 xcut(7,i)=vit
70 DO j=1,3
71 xcut(j,i)=x0(j)
72 ENDDO
73 vnn=sqrt(vn(1)**2+vn(2)**2+vn(3)**2)
74 IF(vnn==zero)THEN
75 WRITE(istdo,1000) idtitl
76 vn(1)=one
77 ELSE
78 vn(1)=vn(1)/vnn
79 vn(2)=vn(2)/vnn
80 vn(3)=vn(3)/vnn
81 ENDIF
82 DO j=1,3
83 icut(j+1,i)=0
84 xcut(j+3,i)=vn(j)
85 ENDDO
86 WRITE(iout,1200)(x0(j),j=1,3),(vn(j),j=1,3),vit
87 ELSE
88 READ(iin,'(3I8)')(icut(j,i),j=2,4)
89 WRITE(iout,1300)(icut(j,i),j=2,4)
90 DO j=1,7
91 xcut(j,i)=zero
92 ENDDO
93 DO j=2,4
94 icut(j,i)=sysfus(icut(j,i),itabm1,numnod,' ** ERROR ** CUT')
95 ENDDO
96 ENDIF
97 ENDDO ! I
98C
99 RETURN
100C
101 1000 FORMAT(//' ** ERROR CUT ',a40,' ZERO VECTOR NORM')
102 2000 FORMAT(' NUMBER OF SOLID CUTS . . . . . . .', i8 //)
103 1100 FORMAT(//' CUT ',a40/
104 . ' TYPE . . . . . . . . . . . . =',i5/
105 . ' =1 PLANE CUT OF DEFORMED GEOMETRY'/
106 . ' =2 DEFORMED CUT OF UNDEFORMED GEOMETRY'/
107 . ' =3 PLANE CUT GIVEN BY 3 REFERENCE NODES')
108 1200 FORMAT(
109 . ' REFERENCE COORDINATES . . . X =',e12.4/
110 . ' . . . . . . . . . . . . . .Y =',e12.4/
111 . ' . . . . . . . . . . . . . .Z =',e12.4/
112 . ' REFERENCE VECTOR . . . . . X =',e12.4/
113 . ' . . . . . . . . . . . . . . Y =',e12.4/
114 . ' . . . . . . . . . . . . . . Z =',e12.4/
115 . ' VELOCITY . . . . . . . . VIT =',e12.4)
116 1300 FORMAT(
117 . ' REFERENCE NODE . . . . . . 1 =',i8/
118 . ' . . . . . . . . . . . . . .2 =',i8/
119 . ' . . . . . . . . . . . . . .3 =',i8)
120 END
#define my_real
Definition cppsort.cpp:32
subroutine leccut(icut, xcut, itabm1)
Definition leccut.F:31
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533