OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i3pen3.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/.
23C
24!||====================================================================
25!|| i3pen3 ../starter/source/interfaces/inter3d1/i3pen3.F
26!||--- called by ------------------------------------------------------
27!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| inist3 ../starter/source/interfaces/inter3d1/inist3.F
31!||--- uses -----------------------------------------------------
32!|| format_mod ../starter/share/modules1/format_mod.F90
33!|| message_mod ../starter/share/message_module/message_mod.F
34!||====================================================================
35 SUBROUTINE i3pen3(X ,IRECT ,MSR ,NSV ,ILOC ,
36 1 IRTL ,CST ,IRTL0,GAP ,NSN ,
37 2 ITAB ,IWPENE,ID,TITR)
38 USE message_mod
39 USE names_and_titles_mod , ONLY : nchartitle
40 USE format_mod , ONLY : fmw_7i, fmw_7i_2f, fmw_i_3f
41C
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "units_c.inc"
50#include "scr03_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NSN,IWPENE
55 my_real GAP
56 INTEGER IRECT(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*), IRTL0(*),ITAB(*)
57 my_real x(3,*), cst(2,*)
58 INTEGER ID
59 CHARACTER(LEN=NCHARTITLE) :: TITR
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER II, I, J, K, L, JJ, NN, IER
64C REAL
65 my_real
66 . n1, n2, n3, pen, alp
67 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
68C-----------------------------------------------
69C E x t e r n a l F u n c t i o n s
70C-----------------------------------------------
71C
72 alp = twoem2
73 DO ii=1,nsn
74 i=nsv(ii)
75 j=iloc(ii)
76 k=msr(j)
77 l=irtl(ii)
78 DO jj=1,4
79 nn=msr(irect(jj,l))
80 xx1(jj)=x(1,nn)
81 xx2(jj)=x(2,nn)
82 xx3(jj)=x(3,nn)
83 ENDDO
84 xs1=x(1,i)
85 ys1=x(2,i)
86 zs1=x(3,i)
87 CALL inist3(n1,n2,n3,cst(1,ii),cst(2,ii),ier,alp,xx1,xx2,xx3,xs1,ys1,zs1,xc,yc,zc)
88 IF(ier==-1)THEN
89C ** ERROR INTERFACE SEGMENT DEFINITION
90C ** ERROR NULL SEGMENT AREA
91 CALL ancmsg(msgid=85,
92 . msgtype=msgerror,
93 . anmode=aninfo,
94 . i1=id,
95 . c1=titr,
96 . i2=itab(i),
97 . i3=itab(k),
98 . i4=l,
99 . i5=itab(msr(irect(1,l))),
100 . i6=itab(msr(irect(2,l))),
101 . i7=itab(msr(irect(3,l))),
102 . i8=itab(msr(irect(4,l))))
103C
104 ELSE IF(ier==1 .AND. ipri>=1)THEN
105 WRITE(iout,fmt=fmw_7i) itab(i),itab(k),l,(itab(msr(irect(jj,l))),jj=1,4)
106 ELSE
107 pen=n1*(xs1-xc)+n2*(ys1-yc)+n3*(zs1-zc)-gap
108 IF(pen<=zero) irtl0(ii)=l
109 IF(pen<zero) THEN
110C ** WARNING ** INITIAL PENETRATION
111 CALL ancmsg(msgid=346,
112 . msgtype=msgwarning,
113 . anmode=aninfo_blind_2,
114 . i1=id,i2=itab(i),
115 . c1=titr,
116 . r1=pen)
117C
118 iwpene=iwpene+1
119 ENDIF
120 IF(ipri>=1) THEN
121 WRITE(iout,fmt=fmw_7i_2f) itab(i),itab(k),l,(itab(msr(irect(jj,l))),jj=1,4),cst(1,ii),cst(2,ii)
122 ENDIF
123 ENDIF
124 ENDDO
125 RETURN
126 END
127!||====================================================================
128!|| i5pwr3 ../starter/source/interfaces/inter3d1/i3pen3.F
129!||--- called by ------------------------------------------------------
130!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
131!||--- calls -----------------------------------------------------
132!|| inist3 ../starter/source/interfaces/inter3d1/inist3.F
133!||--- uses -----------------------------------------------------
134!|| format_mod ../starter/share/modules1/format_mod.F90
135!||====================================================================
136 SUBROUTINE i5pwr3(X ,IRECT ,MSR ,NSV ,ILOC ,
137 1 IRTL ,CST ,IRTL0,GAP ,NSN ,
138 2 ITAB ,INACTI)
139 USE format_mod , ONLY : fmw_i_3f
140C-----------------------------------------------
141C I m p l i c i t T y p e s
142C-----------------------------------------------
143#include "implicit_f.inc"
144C-----------------------------------------------
145C D u m m y A r g u m e n t s
146C-----------------------------------------------
147 INTEGER NSN,INACTI
148 my_real GAP
149 INTEGER IRECT(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*), IRTL0(*), ITAB(*)
150 my_real X(3,*), CST(2,*)
151C-----------------------------------------------
152C C o m m o n B l o c k s
153C-----------------------------------------------
154#include "units_c.inc"
155C-----------------------------------------------
156C L o c a l V a r i a b l e s
157C-----------------------------------------------
158 INTEGER II, I, J, K, L, JJ, NN, IER
159 my_real N1, N2, N3, PEN, ALP
160 my_real :: XX1(4), XX2(4),XX3(4),XS1,YS1,ZS1,XC,YC,ZC
161C-----------------------------------------------
162C E x t e r n a l F u n c t i o n s
163C-----------------------------------------------
164C
165 alp = twoem2
166 DO ii=1,nsn
167 i=nsv(ii)
168 j=iloc(ii)
169 k=msr(j)
170 l=irtl(ii)
171 DO jj=1,4
172 nn=msr(irect(jj,l))
173 xx1(jj)=x(1,nn)
174 xx2(jj)=x(2,nn)
175 xx3(jj)=x(3,nn)
176 ENDDO
177 xs1=x(1,i)
178 ys1=x(2,i)
179 zs1=x(3,i)
180 CALL inist3(n1,n2,n3,cst(1,ii),cst(2,ii),ier,alp,xx1,xx2,xx3,xs1,ys1,zs1,xc,yc,zc)
181 IF(ier==0)THEN
182 pen=n1*(xs1-xc)+n2*(ys1-yc)+n3*(zs1-zc)-gap
183 IF(pen<zero) THEN
184 pen = pen + em8*pen
185 IF(inacti==3) THEN
186 WRITE(iout,1000)pen
187 x(1,i) = xs1 - pen*n1
188 x(2,i) = ys1 - pen*n2
189 x(3,i) = zs1 - pen*n3
190 WRITE(iout,fmt=fmw_i_3f)itab(i),x(1,i),x(2,i),x(3,i)
191 ELSE IF(inacti==4) THEN
192 DO jj=1,4
193 nn=msr(irect(jj,l))
194 WRITE(iout,1100)pen
195 x(1,nn) = xx1(jj) + pen*n1
196 x(2,nn) = xx2(jj) + pen*n2
197 x(3,nn) = xx3(jj) + pen*n3
198 WRITE(iout,fmt=fmw_i_3f)itab(nn),x(1,nn),x(2,nn),x(3,nn)
199 END DO
200 END IF
201 END IF !IF(PEN<ZERO)
202 END IF
203 ENDDO
204 RETURN
205 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
206 . ' CHANGE COORDINATES OF SECONDARY NODE TO:')
207 1100 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
208 . ' CHANGE COORDINATES OF MAIN NODE TO:')
209 END
i5pwr3
subroutine i5pwr3(x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, inacti)
Definition i3pen3.F:139
i3pen3
subroutine i3pen3(x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, iwpene, id, titr)
Definition i3pen3.F:38
inist3
subroutine inist3(n1, n2, n3, ssc, ttc, ier, alp, xx1, xx2, xx3, xs1, ys1, zs1, xc, yc, zc)
Definition inist3.F:33
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
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