OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3dt3.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/.
23!||====================================================================
24!|| c3dt3 ../engine/source/elements/sh3n/coque3n/c3dt3.F
25!||--- called by ------------------------------------------------------
26!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.F
27!|| c3forc3_crk ../engine/source/elements/xfem/c3forc3_crk.F
28!||--- calls -----------------------------------------------------
29!|| cssp2a11 ../engine/source/elements/sh3n/coque3n/cssp2a11.F
30!||====================================================================
31 SUBROUTINE c3dt3(JFT ,JLT ,PM ,OFF ,DT2T ,
32 2 NELTST,ITYPTST,STI ,STIR ,OFFG ,
33 3 SSP ,VISCMX ,ISMSTR ,NFT ,IOFC ,
34 4 ALPE ,MSTG ,DMELTG ,JSMS ,PTG ,
35 5 SHF ,IGTYP ,IGMAT ,G ,A1 ,
36 6 A11R ,G_DT ,DTEL ,ALDT ,THK0 ,
37 7 AREA ,NGL ,IMAT ,MTN ,NEL ,
38 8 ZOFFSET,SSP_EQ)
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "comlock.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "com08_c.inc"
53#include "scr02_c.inc"
54#include "scr07_c.inc"
55#include "scr17_c.inc"
56#include "scr18_c.inc"
57#include "sms_c.inc"
58#include "units_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER JFT, JLT,NELTST,ITYPTST,ISMSTR,NFT,IOFC, JSMS,IGTYP,
63 . IGMAT,IMAT,MTN
64 INTEGER NGL(MVSIZ)
65 my_real
66 . PM(NPROPM,*), OFF(*),STI(*),STIR(*),OFFG(*),SSP(MVSIZ),
67 . VISCMX(MVSIZ),DT2T, MSTG(*), DMELTG(*), PTG(3,*),SHF(*), G(MVSIZ),
68 . A11R(MVSIZ),A1(MVSIZ),ALDT(MVSIZ),THK0(MVSIZ),AREA(MVSIZ),ALPE(MVSIZ)
69 INTEGER,INTENT(IN) :: G_DT, NEL
70 my_real,DIMENSION(JLT), INTENT(INOUT) :: DTEL
71 my_real,DIMENSION(NEL),INTENT(IN) :: zoffset
72 my_real,DIMENSION(NEL),INTENT(IN) :: ssp_eq
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER INDX(MVSIZ),I, II, NINDX,IDT,IFLAG
77 my_real dt(mvsiz)
78 my_real athk, mmin,fac,f_oset(nel),f_dte(nel)
79C=======================================================================
80 DO i=jft,jlt
81 viscmx(i) = sqrt(one + viscmx(i)*viscmx(i)) - viscmx(i)
82 aldt(i) = aldt(i)*viscmx(i) / sqrt(alpe(i))
83 ENDDO
84c---------------------------------------------------
85C
86 f_oset(jft:jlt) = one ! factor is on stiffness
87 f_dte(jft:jlt) = one ! factor is on element dt fat =1/sqrt(f_k)
88 IF (nodadt/=0) THEN
89 IF(igtyp == 52 .OR.
90 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
91 . .AND. igmat > 0 )) THEN
92 DO i=jft,jlt
93 IF (off(i)==zero) THEN
94 sti(i) = zero
95 stir(i) = zero
96 ELSE
97 athk = area(i) * thk0(i)
98 sti(i) = athk * a1(i) / aldt(i)**2
99 fac =a11r(i)*area(i)/ aldt(i)**2
100 stir(i) = fac*(one_over_12* thk0(i)**3 + thk0(i)*zoffset(i)*zoffset(i)
101 . + thk0(i)*half * shf(i) * area(i) * g(i)/a1(i))
102 ENDIF
103 ENDDO
104 ELSE
105 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
106 DO i=jft,jlt
107 a1(i) = pm(24,imat)
108 g(i) = pm(22,imat)
109 ENDDO
110 IF (mtn == 58 .or. mtn == 158) THEN
111 iflag = 1
112 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
113 ELSEIF (mtn == 42 .or. mtn == 62 .or. mtn == 69 .or. mtn == 88) THEN
114 iflag = 2
115 CALL cssp2a11(pm ,imat ,ssp ,a1 ,jlt ,iflag)
116 DO i=jft,jlt
117 fac = max(ssp_eq(i),ssp(i))/ssp(i)
118 f_oset(i) = fac*fac*f_oset(i)
119 ENDDO
120 END IF
121 DO i=jft,jlt
122 IF (off(i)==zero) THEN
123 sti(i) = zero
124 stir(i) = zero
125 ELSE
126 athk = area(i) * thk0(i)
127 sti(i) = athk *f_oset(i)* a1(i) / aldt(i)**2
128 stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12
129 . + half * shf(i) * area(i) * g(i)/a1(i))
130 . + sti(i)*zoffset(i)*zoffset(i)
131c STI(I) = 0.5 * ATHK * A1(I) / ALDT(I)**2
132c STIR(I) = STI(I) * (THK0(I) * THK0(I) / 12.
133c . + AREA(I) /9.)
134 ENDIF
135 ENDDO
136 ENDIF
137C
138 ELSEIF(idtmins == 2)THEN
139 IF(igtyp == 52 .OR.
140 . ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
141 . .AND. igmat > 0 )) THEN
142 DO i=jft,jlt
143 IF (off(i)==zero) THEN
144 sti(i) = zero
145 stir(i) = zero
146 ELSE
147 athk = area(i) * thk0(i)
148 sti(i) = athk * a1(i) / aldt(i)**2
149 fac = a11r(i)*area(i)/ aldt(i)**2
150 stir(i) = fac * (one_over_12* (thk0(i)**3) + thk0(i)*zoffset(i)*zoffset(i)
151 . + half * thk0(i)*shf(i) * area(i) * g(i)/a1(i))
152 ENDIF
153 END DO
154 ELSE
155 DO i=jft,jlt
156 a1(i) = pm(24,imat)
157 g(i) = pm(22,imat)
158 ENDDO
159 DO i=jft,jlt
160 IF (off(i)==zero) THEN
161 sti(i) = zero
162 stir(i) = zero
163 ELSE
164 athk = area(i) * thk0(i)
165 sti(i) = athk * a1(i) / aldt(i)**2
166 stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12
167 . + half * shf(i) * area(i) * g(i)/a1(i))
168 ENDIF
169 END DO
170 ENDIF
171C
172 IF(jsms /= 0)THEN
173 DO i=jft,jlt
174 IF(offg(i) < zero .OR. off(i) == zero) cycle
175c
176 mmin=mstg(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 dmeltg(i)=max(dmeltg(i),
182 . (dtmins/dtfacs)**2 * sti(i) - two*mmin)
183 dt(i) = dtfacs*
184 . sqrt((two*mmin+dmeltg(i))/max(em20,sti(i)))
185 IF(dt(i)<dt2t)THEN
186 dt2t = dt(i)
187 neltst = ngl(i)
188 ityptst = 7
189 END IF
190 END DO
191 ENDIF
192C
193 ELSE ! NODADT=0
194 f_oset(jft:jlt)= one + zep2*abs(zoffset(jft:jlt))/thk0(jft:jlt)
195 IF(igtyp==1.OR.igtyp==9) THEN
196 DO i=jft,jlt
197 f_dte(i) = one/sqrt(f_oset(i))
198 END DO
199 END IF
200 IF (mtn == 42 .or. mtn == 62 .or. mtn == 69) THEN
201 DO i=jft,jlt
202 fac = ssp(i)/max(ssp_eq(i),ssp(i))
203 f_dte(i) = fac*f_dte(i)
204 ENDDO
205 DO i=jft,jlt
206 fac = max(ssp_eq(i),ssp(i))/ssp(i)
207 f_oset(i) = fac*fac*f_oset(i)
208 ENDDO
209 END IF
210 ENDIF
211C
212 DO i=jft,jlt
213 dt(i)=dtfac1(7)*f_dte(i)*aldt(i)/ssp(i)
214 END DO
215 IF(g_dt/=zero)THEN
216 DO i=jft,jlt
217 dtel(i) = dt(i)
218 ENDDO
219 ENDIF
220C
221 IF (idtmin(7)==0) RETURN
222C
223 nindx=iofc
224 IF(idtmin(7)==1)THEN
225 DO 100 i=jft,jlt
226 IF(dt(i)>dtmin1(7).OR.off(i)<one
227 . .OR.offg(i)==two.OR.offg(i)<zero) GO TO 100
228 tstop = tt
229C
230#include "lockon.inc"
231 WRITE(iout,1000) ngl(i)
232 WRITE(istdo,1000) ngl(i)
233#include "lockoff.inc"
234 100 CONTINUE
235 ELSEIF(idtmin(7)==2)THEN
236 DO 120 i=jft,jlt
237 IF(dt(i)>dtmin1(7).OR.off(i)<one
238 . .OR.offg(i)<zero) GO TO 120
239 off(i)=zero
240
241 ii=i+nft
242 nindx=nindx+1
243 indx(nindx)=i
244 idel7nok = 1
245C
246#include "lockon.inc"
247 WRITE(iout,1200) ngl(i)
248 WRITE(istdo,1300) ngl(i),tt
249#include "lockoff.inc"
250 120 CONTINUE
251 iofc = nindx
252 ELSEIF(ismstr==2.AND.idtmin(7)==3)THEN
253 DO 140 i=jft,jlt
254 IF(dt(i)>dtmin1(7).OR.
255 . off(i)<one.OR.offg(i)==two.OR.offg(i)<zero) GO TO 140
256 offg(i)=two
257C
258#include "lockon.inc"
259 WRITE(iout,1400) ngl(i)
260 WRITE(istdo,1400) ngl(i)
261#include "lockoff.inc"
262 140 CONTINUE
263 ELSEIF(idtmin(7)==5)THEN
264 DO 150 i=jft,jlt
265 IF(dt(i)>dtmin1(7).OR.off(i)<one.
266 . or.offg(i)==two.OR.offg(i)<zero) GO TO 150
267 mstop = 2
268C
269#include "lockon.inc"
270 WRITE(iout,1000) ngl(i)
271 WRITE(istdo,1000) ngl(i)
272#include "lockoff.inc"
273 150 CONTINUE
274 ENDIF
275C
276 IF(nodadt/=0.OR.(idtmins==2.AND.jsms/=0))RETURN
277C
278C- VECTOR
279 idt=0
280 DO i=jft,jlt
281 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t) idt=1
282 ENDDO
283C- NON VECTOR
284 IF(idt==1)THEN
285 DO i=jft,jlt
286 IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t)THEN
287 dt2t = dt(i)
288 neltst = ngl(i)
289 ityptst = 7
290 ENDIF
291 ENDDO
292 ENDIF
293C
294 IF(idtmins==2)RETURN
295C
296 DO i=jft,jlt
297 sti(i) = area(i) * thk0(i) * f_oset(i) * a1(i) / aldt(i)**2
298 sti(i) = zep81 * zep81 * sti(i) * off(i)
299 stir(i)= zero
300 ENDDO
301C-----------
302 1000 FORMAT(1x,'-- MINIMUM TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
303 1200 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT NUMBER ',i10)
304 1300 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT :',i10,' AT TIME :',g11.4)
305 1400 FORMAT(1x,'-- CONSTANT TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
306C-----------
307 RETURN
308 END
c3dt3
subroutine c3dt3(jft, jlt, pm, off, dt2t, neltst, ityptst, sti, stir, offg, ssp, viscmx, ismstr, nft, iofc, alpe, mstg, dmeltg, jsms, ptg, shf, igtyp, igmat, g, a1, a11r, g_dt, dtel, aldt, thk0, area, ngl, imat, mtn, nel, zoffset, ssp_eq)
Definition c3dt3.F:39
cssp2a11
subroutine cssp2a11(pm, imat, ssp, a11, nel, iflag)
Definition cssp2a11.F:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21