OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cndt3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "param_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 "com04_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cndt3 (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, mtn, pm, imat, nel, zoffset, ssp_eq)

Function/Subroutine Documentation

◆ cndt3()

subroutine cndt3 ( 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,
integer mtn,
intent(in) pm,
integer imat,
integer, intent(in) nel,
intent(in) zoffset,
intent(in) ssp_eq )

Definition at line 34 of file cndt3.F.

42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com08_c.inc"
55#include "param_c.inc"
56#include "scr02_c.inc"
57#include "scr07_c.inc"
58#include "scr17_c.inc"
59#include "scr18_c.inc"
60#include "sms_c.inc"
61#include "units_c.inc"
62#include "com04_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER JFT, JLT,NELTST,ITYPTST,ISMSTR,IOFC,NNE, JSMS,IGTYP
67 INTEGER NGL(*),IGMAT,G_DT,MTN,IMAT
68 INTEGER , INTENT(IN) :: NEL
69C REAL
70 my_real off(*),sti(*),stir(*),offg(*),ssp(*),amu(*),
71 . aldt(*), alpe(*), a1(*), thk0(*),thk02(*),
72 . vol0(*), viscmx(*), rho(*),dt2t, area(*), g(*), shf(*),
73 . msc(*), dmelc(*), ptg(3,*),a11r(*),dtel(mvsiz)
74 my_real, DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: pm
75 my_real, DIMENSION(NEL) , INTENT(IN) :: zoffset
76 my_real, DIMENSION(MVSIZ),INTENT(IN) :: ssp_eq
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER INDXOF(MVSIZ),
81 . I, J, NINDX,IDT,ITYEL,IFLAG
82 my_real dt(mvsiz),fac,divm,mmin ,f_oset(nel),f_dte(nel)
83C=======================================================================
84 DO i=jft,jlt
85 viscmx(i) = max(viscmx(i), amu(i))
86 viscmx(i) = sqrt(one + viscmx(i)*viscmx(i)) - viscmx(i)
87 aldt(i) = aldt(i) * viscmx(i) / sqrt(alpe(i))
88 ENDDO
89c---------------------------------------------------
90C
91 ityel = 3
92 IF (nne==3) ityel = 7
93 f_oset(jft:jlt) = one ! factor is on stiffness
94 f_dte(jft:jlt) = one ! factor is on element dt fat =1/sqrt(f_k)
95 IF (nodadt/=0) THEN
96 IF(igtyp == 52 .OR.
97 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
98 . .AND. igmat > 0 )) THEN
99 ELSE
100! take into account nonlinear stiffnening laws
101 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
102 IF (mtn == 58 .or. mtn == 158) THEN
103 iflag = 1
104 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
105 ELSEIF (mtn == 42 .or. mtn == 62 .or. mtn == 69 .or. mtn == 88) THEN
106 iflag = 2
107 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
108 DO i=jft,jlt
109 fac = max(ssp_eq(i),ssp(i))/ssp(i)
110 f_oset(i) = fac*fac*f_oset(i)
111 ENDDO
112 END IF
113 END IF
114 ELSE
115 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
116 IF(igtyp==1.OR.igtyp==9) THEN
117 DO i=jft,jlt
118 fac = f_oset(i)
119 f_dte(i) = one/sqrt(fac)
120 END DO
121 END IF
122 IF (mtn == 42 .or. mtn == 62 .or. mtn == 69 .or. mtn == 88) THEN
123 DO i=jft,jlt
124 fac = ssp(i)/max(ssp_eq(i),ssp(i))
125 f_dte(i) = fac*f_oset(i)
126 ENDDO
127 DO i=jft,jlt
128 fac = max(ssp_eq(i),ssp(i))/ssp(i)
129 f_oset(i) = fac*fac*f_oset(i)
130 ENDDO
131 END IF
132 END IF
133C----- isub will add here-----
134 IF(idtmins == 2)THEN
135 DO i=jft,jlt
136 IF (off(i)==zero) THEN
137 sti(i) = zero
138 stir(i) = zero
139 ELSE
140 sti(i) = half*vol0(i) * a1(i) / aldt(i)**2
141 IF(igtyp == 52 .OR.
142 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
143 . .AND. igmat > 0 )) THEN
144 fac = half*vol0(i)/ aldt(i)**2
145 stir(i) =fac * a11r(i)*(thk02(i)*one_over_12 + zoffset(i)*zoffset(i))
146 . + fac * a1(i) *area(i)*one_over_12
147 ELSE
148 stir(i) = sti(i) * (thk02(i)+area(i)) *one_over_12
149 . + sti(i)*zoffset(i)*zoffset(i)
150 ENDIF
151 ENDIF
152 ENDDO
153C
154 IF(jsms /= 0)THEN
155 IF(ityel==3)THEN
156 DO i=jft,jlt
157 IF(offg(i) < zero .OR. off(i) == zero) cycle
158c
159c dmelc = 2*dmelc !!
160c w^2 < 2k / (m+dmelc+dmelc/3) < 2k / (m+dmelc)
161c dt = 2/w = sqrt( 2*(m+dmelc)/k)
162 dmelc(i)=max(dmelc(i),
163 . (dtmins/dtfacs)**2 * sti(i) - two*msc(i))
164 dt(i) = dtfacs*
165 . sqrt((two*msc(i)+dmelc(i))/max(em20,sti(i)))
166 IF(dt(i)<dt2t)THEN
167 dt2t = dt(i)
168 neltst = ngl(i)
169 ityptst = ityel
170 END IF
171 END DO
172 ELSE
173 DO i=jft,jlt
174 IF(offg(i) < zero .OR. off(i) == zero) cycle
175c
176 mmin=msc(i)*min(ptg(1,i),ptg(2,i),ptg(3,i))
177c
178c dmelc = 2*dmelc !!
179c w^2 < 2k / (m+dmelc+dmelc/2) < 2k / (m+dmelc)
180c dt = 2/w = sqrt( 2*(m+dmelc)/k)
181 dmelc(i)=max(dmelc(i),
182 . (dtmins/dtfacs)**2 * sti(i) - two*mmin)
183 dt(i) = dtfacs*
184 . sqrt((two*mmin+dmelc(i))/max(em20,sti(i)))
185 IF(dt(i)<dt2t)THEN
186 dt2t = dt(i)
187 neltst = ngl(i)
188 ityptst = ityel
189 END IF
190 END DO
191 END IF
192 ENDIF
193 ELSEIF(nodadt/=0)THEN
194 IF(igtyp == 52 .OR.
195 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
196 . .AND. igmat > 0 ))THEN
197 DO i=jft,jlt
198 IF (off(i)==zero) THEN
199 sti(i) = zero
200 stir(i) = zero
201 ELSE
202 sti(i) = half*vol0(i) * a1(i) / aldt(i)**2
203 fac = half*vol0(i)/ aldt(i)**2
204 stir(i) = fac*a11r(i)*(thk02(i)*one_over_12 + zoffset(i)*zoffset(i))
205 . + fac *a1(i)*area(i)*one_over_12
206 ENDIF
207 ENDDO
208 ELSE
209 DO i=jft,jlt
210 IF (off(i)==zero) THEN
211 sti(i) = zero
212 stir(i) = zero
213 ELSE
214 sti(i) = half*f_oset(i)*vol0(i) * a1(i) / aldt(i)**2
215 stir(i) = sti(i) * (thk02(i)+area(i)) *one_over_12
216 . + sti(i)*zoffset(i)*zoffset(i)
217 ENDIF
218 ENDDO
219 ENDIF
220 ENDIF
221C
222 DO i=jft,jlt
223 dt(i)=dtfac1(ityel)*f_dte(i)*aldt(i)/ssp(i)
224 ENDDO
225 IF(g_dt>0)THEN
226 DO i=jft,jlt
227 dtel(i)=f_dte(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.
228 ENDDO
229 ENDIF
230 IF((nodadt/=0.OR.idtmins==2).AND.idtmin(ityel)==0)RETURN
231C
232 IF(idtmin(ityel)>=1)THEN
233 nindx=iofc
234 DO i=jft,jlt
235 IF(dt(i)<=dtmin1(ityel).AND.
236 . off(i)>=one.AND.offg(i)/=two.AND.offg(i)>=zero) THEN
237 nindx=nindx+1
238 indxof(nindx)=i
239 ENDIF
240 ENDDO
241 ENDIF
242C
243 IF(idtmin(ityel)==1)THEN
244
245 IF(nindx>iofc) mstop = 2
246
247 DO 100 j=iofc+1,nindx
248 i = indxof(j)
249#include "lockon.inc"
250 WRITE(iout,1000) nne,ngl(i)
251 WRITE(istdo,1000) nne,ngl(i)
252#include "lockoff.inc"
253 100 CONTINUE
254 ELSEIF(idtmin(ityel)==2)THEN
255 IF(nindx>iofc) idel7nok = 1
256 DO 125 j=iofc+1,nindx
257 i = indxof(j)
258 off(i)=0.
259#include "lockon.inc"
260 WRITE(iout,1200) nne,ngl(i)
261 WRITE(istdo,1300) nne,ngl(i),tt
262#include "lockoff.inc"
263 125 CONTINUE
264 iofc = nindx
265 ELSEIF(idtmin(ityel)==3.AND.ismstr==2)THEN
266 DO 140 j=iofc+1,nindx
267 i = indxof(j)
268 offg(i)=2.
269#include "lockon.inc"
270 WRITE(iout,1400) nne,ngl(i)
271 WRITE(istdo,1400) nne,ngl(i)
272#include "lockoff.inc"
273 140 CONTINUE
274 nindx=iofc
275 ELSEIF(idtmin(ityel)==5)THEN
276 IF(nindx>iofc) mstop = 2
277 DO 160 j=iofc+1,nindx
278 i = indxof(j)
279#include "lockon.inc"
280 WRITE(iout,1000) nne,ngl(i)
281 WRITE(istdo,1000) nne,ngl(i)
282#include "lockoff.inc"
283 160 CONTINUE
284 nindx=iofc
285 ENDIF
286C
287C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
288 1000 FORMAT(1x,'--MINIMUM TIME STEP ',i1,'N SHELL ELEMENT NUMBER ',i10)
289 1200 FORMAT(1x,'--DELETE ',i1,'N SHELL ELEMENT NUMBER ',i10)
290 1300 FORMAT(1x,'--DELETE ',i1',N SHELL ELEMENT:',i10,' AT TIME:',g11.4)
291 1400 FORMAT(1x,'--CONSTANT TIME STEP ',i1,'N SHELL ELEMENT NUMBER',i10)
292C
293 IF(nodadt/=0.OR.(idtmins==2.AND.jsms/=0))RETURN
294C
295C- VECTOR
296 idt=0
297 DO i=jft,jlt
298 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t) idt=1
299 ENDDO
300C- NON VECTOR
301 IF(idt==1)THEN
302 DO i=jft,jlt
303 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t)THEN
304 dt2t = dt(i)
305 neltst = ngl(i)
306 ityptst = ityel
307 ENDIF
308 ENDDO
309 ENDIF
310C
311 IF(idtmins==2)RETURN
312C
313 DO i=jft,jlt
314 divm=max(aldt(i)*aldt(i),em20)
315 sti(i) = half*f_oset(i)*vol0(i) * a1(i)* off(i) / divm
316 stir(i)= zero
317 ENDDO
318C
319 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
cssp2a11
subroutine cssp2a11(pm, imat, ssp, a11, nel, iflag)
Definition cssp2a11.F: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