OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cndt3pinch.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "scr02_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "sms_c.inc"
#include "units_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cndt3pinch (jft, jlt, off, dt2t, amu, neltst, ityptst, sti, stir, offg, ssp, viscmx, rho, vol0, thk0, thk02, a1, aldt, alpe, ngl, ismstr, iofc, nne, area, g, shf, msc, dmelc, jsms, ptg, igtyp, igmat, a11r, g_dt, dtel, a11pinch)

Function/Subroutine Documentation

◆ cndt3pinch()

subroutine cndt3pinch ( integer jft,
integer jlt,
off,
dt2t,
amu,
integer neltst,
integer ityptst,
sti,
stir,
offg,
ssp,
viscmx,
rho,
vol0,
thk0,
thk02,
a1,
aldt,
alpe,
integer, dimension(*) ngl,
integer ismstr,
integer iofc,
integer nne,
area,
g,
shf,
msc,
dmelc,
integer jsms,
ptg,
integer igtyp,
integer igmat,
a11r,
integer g_dt,
dtel,
a11pinch )

Definition at line 28 of file cndt3pinch.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com08_c.inc"
48#include "scr02_c.inc"
49#include "scr07_c.inc"
50#include "scr17_c.inc"
51#include "scr18_c.inc"
52#include "sms_c.inc"
53#include "units_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER JFT, JLT,NELTST,ITYPTST,ISMSTR,IOFC,NNE, JSMS,IGTYP
58 INTEGER NGL(*),IGMAT,G_DT
59C REAL
60 my_real
61 . off(*),sti(*),stir(*),offg(*),ssp(*),amu(*),
62 . aldt(*), alpe(*), a1(*), thk0(*),thk02(*),
63 . vol0(*), viscmx(*), rho(*),dt2t, area(*), g(*), shf(*),
64 . msc(*), dmelc(*), ptg(3,*),a11r(*),dtel(mvsiz), a11pinch
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER INDXOF(MVSIZ),
69 . I, J, II, NINDX,IDT,ITYEL
70 my_real dt(mvsiz),fac,mas,divm,mmin ,iz
71C=======================================================================
72 DO i=jft,jlt
73 viscmx(i) = max(viscmx(i), amu(i))
74 viscmx(i) = sqrt(one + viscmx(i)*viscmx(i)) - viscmx(i)
75 aldt(i) = aldt(i) * viscmx(i) / sqrt(alpe(i))
76 ENDDO
77c---------------------------------------------------
78 ityel = 3
79 IF (nne==3) ityel = 7
80C----- isub will add here-----
81 IF(idtmins == 2)THEN
82 DO i=jft,jlt
83 IF (off(i)==zero) THEN
84 sti(i) = zero
85 stir(i) = zero
86 ELSE
87 sti(i) = half*vol0(i) * a11pinch / aldt(i)**2
88
89 IF(igtyp == 52 .OR.
90 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
91 . .AND. igmat > 0 )) THEN
92 fac = half*vol0(i)/ aldt(i)**2
93 stir(i) =(fac * a11r(i)*thk02(i) +
94 . fac * a1(i) *area(i)) *one_over_12
95 ELSE
96 stir(i) = sti(i) * (thk02(i)+area(i)) *one_over_12
97 ENDIF
98 ENDIF
99 ENDDO
100C
101 IF(jsms /= 0)THEN
102 IF(ityel==3)THEN
103 DO i=jft,jlt
104 IF(offg(i) < zero .OR. off(i) == zero) cycle
105c
106c dmelc = 2*dmelc !!
107c w^2 < 2k / (m+dmelc+dmelc/3) < 2k / (m+dmelc)
108c dt = 2/w = sqrt( 2*(m+dmelc)/k)
109 dmelc(i)=max(dmelc(i),
110 . (dtmins/dtfacs)**2 * sti(i) - two*msc(i))
111 dt(i) = dtfacs*
112 . sqrt((two*msc(i)+dmelc(i))/max(em20,sti(i)))
113 IF(dt(i)<dt2t)THEN
114 dt2t = dt(i)
115 neltst = ngl(i)
116 ityptst = ityel
117 END IF
118 END DO
119 ELSE
120 DO i=jft,jlt
121 IF(offg(i) < zero .OR. off(i) == zero) cycle
122c
123 mmin=msc(i)*min(ptg(1,i),ptg(2,i),ptg(3,i))
124c
125c dmelc = 2*dmelc !!
126c w^2 < 2k / (m+dmelc+dmelc/2) < 2k / (m+dmelc)
127c dt = 2/w = sqrt( 2*(m+dmelc)/k)
128 dmelc(i)=max(dmelc(i),
129 . (dtmins/dtfacs)**2 * sti(i) - two*mmin)
130 dt(i) = dtfacs*
131 . sqrt((two*mmin+dmelc(i))/max(em20,sti(i)))
132 IF(dt(i)<dt2t)THEN
133 dt2t = dt(i)
134 neltst = ngl(i)
135 ityptst = ityel
136 END IF
137 END DO
138 END IF
139 ENDIF
140 ELSEIF(nodadt/=0)THEN
141C IF(IGTYP == 52 .OR.
142C . ((IGTYP == 11 .OR. IGTYP == 17 .OR. IGTYP == 51)
143C . .AND. IGMAT > 0 ))THEN
144C DO I=JFT,JLT
145C IF (OFF(I)==ZERO) THEN
146C STI(I) = ZERO
147C STIR(I) = ZERO
148C ELSE
149C STI(I) = HALF*VOL0(I) * A11PINCH / ALDT(I)**2
150C FAC = HALF*VOL0(I)/ ALDT(I)**2
151C STIR(I) = FAC*A11R(I)*THK02(I)*ONE_OVER_12 +
152C . FAC *A11PINCH*AREA(I)*ONE_OVER_12
153C ENDIF
154C ENDDO
155C ELSE
156 DO i=jft,jlt
157 IF (off(i)==zero) THEN
158 sti(i) = zero
159 stir(i) = zero
160 ELSE
161 sti(i) = half*vol0(i) * a11pinch / aldt(i)**2
162 stir(i) = sti(i) * (thk02(i)+area(i)) *one_over_12
163 ENDIF
164 ENDDO
165C ENDIF
166 ENDIF
167C
168 DO i=jft,jlt
169 dt(i)=dtfac1(ityel)*aldt(i)/ssp(i)
170 ENDDO
171 IF(g_dt>0)THEN
172 DO i=jft,jlt
173 dtel(i)=aldt(i)/ssp(i) ! DT=ALDT(I)/SSP(I) & DT=DT*DTFAC1 does not lead to same digits, so operation is made again here.
174 ENDDO
175 ENDIF
176 IF((nodadt/=0.OR.idtmins==2).AND.idtmin(ityel)==0)RETURN
177C
178 IF(idtmin(ityel)>=1)THEN
179 nindx=iofc
180 DO i=jft,jlt
181 IF(dt(i)<=dtmin1(ityel).AND.
182 . off(i)>=one.AND.offg(i)/=two.AND.offg(i)>=zero) THEN
183 nindx=nindx+1
184 indxof(nindx)=i
185 ENDIF
186 ENDDO
187 ENDIF
188C
189 IF(idtmin(ityel)==1)THEN
190
191 IF(nindx>iofc) mstop = 2
192
193 DO 100 j=iofc+1,nindx
194 i = indxof(j)
195#include "lockon.inc"
196 WRITE(iout,1000) nne,ngl(i)
197 WRITE(istdo,1000) nne,ngl(i)
198#include "lockoff.inc"
199 100 CONTINUE
200 ELSEIF(idtmin(ityel)==2)THEN
201 IF(nindx>iofc) idel7nok = 1
202 DO 125 j=iofc+1,nindx
203 i = indxof(j)
204 off(i)=0.
205#include "lockon.inc"
206 WRITE(iout,1200) nne,ngl(i)
207 WRITE(istdo,1300) nne,ngl(i),tt
208#include "lockoff.inc"
209 125 CONTINUE
210 iofc = nindx
211 ELSEIF(idtmin(ityel)==3.AND.ismstr==2)THEN
212 DO 140 j=iofc+1,nindx
213 i = indxof(j)
214 offg(i)=2.
215#include "lockon.inc"
216 WRITE(iout,1400) nne,ngl(i)
217 WRITE(istdo,1400) nne,ngl(i)
218#include "lockoff.inc"
219 140 CONTINUE
220 nindx=iofc
221 ELSEIF(idtmin(ityel)==5)THEN
222 IF(nindx>iofc) mstop = 2
223 DO 160 j=iofc+1,nindx
224 i = indxof(j)
225#include "lockon.inc"
226 WRITE(iout,1000) nne,ngl(i)
227 WRITE(istdo,1000) nne,ngl(i)
228#include "lockoff.inc"
229 160 CONTINUE
230 nindx=iofc
231 ENDIF
232C
233C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
234 1000 FORMAT(1x,'--MINIMUM TIME STEP ',i1,'N SHELL ELEMENT NUMBER ',i10)
235 1200 FORMAT(1x,'--DELETE ',i1,'N SHELL ELEMENT NUMBER ',i10)
236 1300 FORMAT(1x,'--DELETE ',i1',N SHELL ELEMENT:',i10,' AT TIME:',g11.4)
237 1400 FORMAT(1x,'--CONSTANT TIME STEP ',i1,'N SHELL ELEMENT NUMBER',i10)
238C
239 IF(nodadt/=0.OR.(idtmins==2.AND.jsms/=0))RETURN
240C
241C- VECTOR
242 idt=0
243 DO i=jft,jlt
244 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t) idt=1
245 ENDDO
246C- NON VECTOR
247 IF(idt==1)THEN
248 DO i=jft,jlt
249 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t)THEN
250 dt2t = dt(i)
251 neltst = ngl(i)
252 ityptst = ityel
253 ENDIF
254 ENDDO
255 ENDIF
256C
257 IF(idtmins==2)RETURN
258C
259 DO i=jft,jlt
260 divm=max(aldt(i)*aldt(i),em20)
261 sti(i) = half*vol0(i) * a11pinch* off(i) / divm
262 stir(i)= zero
263 ENDDO
264C
265 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
dtel
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
Definition dtel.F:46
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21