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

Go to the source code of this file.

Functions/Subroutines

subroutine i25pwr3 (itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, pene_old, noint, nty, msr, irtlm, irect, nsn, id, titr, mseglo, icont_i, iwpene0, penmin, iresp)
subroutine i25cand (cand_e, cand_n, nsn, irtlm, ii_stok, nrtm, msegtyp)

Function/Subroutine Documentation

◆ i25cand()

subroutine i25cand ( integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer nsn,
integer, dimension(4,*) irtlm,
integer ii_stok,
integer nrtm,
integer, dimension(*) msegtyp )

Definition at line 152 of file i25pwr3.F.

154C
155C-----------------------------------------------
156C I m p l i c i t T y p e s
157C-----------------------------------------------
158#include "implicit_f.inc"
159C-----------------------------------------------
160C C o m m o n B l o c k s
161C-----------------------------------------------
162 INTEGER CAND_E(*),CAND_N(*),NSN,IRTLM(4,*),II_STOK,
163 * NRTM,MSEGTYP(*)
164C-----------------------------------------------
165C L o c a l V a r i a b l e s
166C-----------------------------------------------
167 INTEGER E, I,ISH
168 .
169C-----------------------------------------------
170C E x t e r n a l F u n c t i o n s
171C-----------------------------------------------
172 ii_stok = 0
173 DO i=1,nsn
174 e = irtlm(1,i)
175 IF (e > 0) THEN
176 ii_stok =ii_stok + 1
177 cand_n(ii_stok) = i
178 cand_e(ii_stok) = e
179
180 ish = msegtyp(e)
181C
182Cf i25pen3.F <=> (ABS(ISH) /= 0 .AND. ABS(ISH) <= NRTM) .OR. ISH > NRTM
183 IF (ish /= 0)THEN
184C
185C coating shells and their opposite segment ::
186 IF(ish > nrtm)ish=ish-nrtm
187C
188 ii_stok =ii_stok + 1
189 cand_n(ii_stok) = i
190 cand_e(ii_stok) = abs(ish)
191 ENDIF
192
193 END IF
194 END DO
195C
196 RETURN

◆ i25pwr3()

subroutine i25pwr3 ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stfn,
x,
integer i_stok,
integer, dimension(*) nsv,
integer iwpene,
pene_old,
integer noint,
integer nty,
integer, dimension(*) msr,
integer, dimension(4,*) irtlm,
integer, dimension(4,*) irect,
integer nsn,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) mseglo,
integer, dimension(nsn), intent(out) icont_i,
integer, intent(inout) iwpene0,
intent(inout) penmin,
integer, intent(in) iresp )

Definition at line 32 of file i25pwr3.F.

37 USE message_mod
38 USE names_and_titles_mod , ONLY : nchartitle
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "scr03_c.inc"
47#include "units_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER ITAB(*),CAND_E(*),CAND_N(*), IRECT(4,*), IRTLM(4,*),
52 . MSEGLO(*)
53 INTEGER I_STOK,NSV(*),MSR(*),IWPENE,INACTI,NOINT,NTY,NSN
54 INTEGER , INTENT(OUT) :: ICONT_I(NSN)
55 INTEGER , INTENT(IN) :: IRESP
56 INTEGER , INTENT(INOUT) :: IWPENE0
57 my_real , INTENT(INOUT) :: penmin
58C REAL
59 my_real
60 . stfn(*),x(3,*),pene_old(5,*)
61 INTEGER ID
62 CHARACTER(LEN=NCHARTITLE) :: TITR
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, L
67 INTEGER IX1, IX2, IX3, IX4, NSVG
68 my_real tol
69C REAL
70C-----------------------------------------------
71 IF (iresp==1.AND.penmin<=em06) penmin = two*em06
72 tol = penmin
73 DO 100 i=1,i_stok
74 j=cand_n(i)
75 l=cand_e(i)
76
77 IF(irtlm(1,j)==mseglo(cand_e(i)))THEN
78
79 ix1=irect(1,l)
80 ix2=irect(2,l)
81 ix3=irect(3,l)
82 ix4=irect(4,l)
83 nsvg=nsv(j)
84
85C
86
87 IF(pene_old(5,j)/=zero)THEN
88C True initial penetration
89 iwpene=iwpene+1
90
91 IF(ipri>=5 )
92 . CALL ancmsg(msgid=1164,
93 . msgtype=msgwarning,
94 . anmode=aninfo_blind_1,
95 . i1=itab(nsvg),
96 . i2=itab(ix1),
97 . i3=itab(ix2),
98 . i4=itab(ix3),
99 . i5=itab(ix4),
100 . r1=pene_old(5,j),
101 . prmod=msg_cumu)
102 IF(inacti==0)THEN
103C Ignore initial penetrations
104 icont_i(j)=-irtlm(1,j)
105 IF (pene_old(5,j)<=tol) THEN
106 iwpene0=iwpene0+1
107 ELSE
108 irtlm(1,j) = 0
109 irtlm(2,j) = 0
110 irtlm(3,j) = 0
111 ENDIF
112 pene_old(5,j)= zero
113 ELSEIF(inacti==1) THEN
114C DEACTIVATION OF NODES
115 WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
116 stfn(j) = zero
117 icont_i(j)=-irtlm(1,j)
118C ELSE IF(INACTI==2) THEN
119C DEACTIVATION OF ELEMENTS
120C WRITE(IOUT,'(A)')
121C . 'INACTI=2 IS NOT AVAILABLE FOR INTERFACE TYPE25'
122C ELSE IF(INACTI==3) THEN
123C CHANGE THE COORDINATES OF SECONDARY NODES
124C WRITE(IOUT,'(A)')
125C . 'INACTI=3 IS NOT AVAILABLE FOR INTERFACE TYPE25'
126C ELSE IF(INACTI==4) THEN
127C CHANGE THE COORDINATES OF MAIN NODES
128C WRITE(IOUT,'(A)')
129C . 'INACTI=4 IS NOT AVAILABLE FOR INTERFACE TYPE25'
130 ELSE IF(inacti==5) THEN
131C GAP REDUCTION
132 ELSE IF(inacti==-1) THEN
133C Initial penetrations <=> Initial forces
134 pene_old(5,j)= zero
135 ENDIF
136 ELSE
137C Reset (Same tracking will be done again in Engine)
138 irtlm(1,j)=0
139 irtlm(2,j)=0
140 irtlm(3,j)=0
141 END IF
142 END IF
143 100 CONTINUE
144C
145 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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:895