OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cndt3pinch.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!|| cndt3pinch ../engine/source/elements/shell/coqueba/cndt3pinch.F
25!||--- called by ------------------------------------------------------
26!|| cbaforc3 ../engine/source/elements/shell/coqueba/cbaforc3.F
27!||====================================================================
28 SUBROUTINE cndt3pinch(JFT ,JLT ,OFF ,DT2T ,AMU ,
29 1 NELTST,ITYPTST ,STI ,STIR ,OFFG,
30 2 SSP ,VISCMX ,RHO ,VOL0 ,THK0,THK02,
31 3 A1 ,ALDT ,ALPE ,NGL ,ISMSTR,
32 4 IOFC ,NNE ,AREA ,G ,SHF ,
33 5 MSC ,DMELC ,JSMS ,PTG ,IGTYP ,
34 6 IGMAT ,A11R ,G_DT ,DTEL ,A11PINCH)
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
266 END
cndt3pinch
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)
Definition cndt3pinch.F:35
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