OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i3pen3.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i3pen3 (x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, iwpene, id, titr)
subroutine i5pwr3 (x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, inacti)

Function/Subroutine Documentation

◆ i3pen3()

subroutine i3pen3 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) iloc,
integer, dimension(*) irtl,
cst,
integer, dimension(*) irtl0,
gap,
integer nsn,
integer, dimension(*) itab,
integer iwpene,
integer id,
character(len=nchartitle) titr )

Definition at line 35 of file i3pen3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
inist3
subroutine inist3(n1, n2, n3, ssc, ttc, ier, alp, xx1, xx2, xx3, xs1, ys1, zs1, xc, yc, zc)
Definition inist3.F:33
id
initmumps id
Definition multiplerhs_example.m:4
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

◆ i5pwr3()

subroutine i5pwr3 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) iloc,
integer, dimension(*) irtl,
cst,
integer, dimension(*) irtl0,
gap,
integer nsn,
integer, dimension(*) itab,
integer inacti )

Definition at line 136 of file i3pen3.F.

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:')