OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pdlen3.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!|| pdlen3 ../engine/source/elements/beam/pdlen3.F
25!||--- called by ------------------------------------------------------
26!|| pforc3 ../engine/source/elements/beam/pforc3.F
27!||====================================================================
28 SUBROUTINE pdlen3(
29 1 JFT, JLT, PM, GEO,
30 2 OFFG, DT2T, NELTST, ITYPTST,
31 3 STI, STIR, MSP, DMELP,
32 4 G_DT, DTEL, AL, MAT,
33 5 PID, NGL, NEL, IGTYP,
34 6 JSMS)
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 "param_c.inc"
49#include "scr02_c.inc"
50#include "scr07_c.inc"
51#include "scr17_c.inc"
52#include "scr18_c.inc"
53#include "sms_c.inc"
54#include "units_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(IN) :: NEL
59 INTEGER, INTENT(IN) :: IGTYP
60 INTEGER, INTENT(IN) :: JSMS
61 my_real,INTENT(INOUT) :: DTEL(JFT:JLT)
62 INTEGER,INTENT(IN) :: G_DT
63 INTEGER JFT,JLT,NELTST ,ITYPTST,MAT(MVSIZ),PID(MVSIZ),
64 . ngl(mvsiz)
65 my_real dt2t ,
66 . pm(npropm,*), geo(npropg,*), offg(*), sti(*), stir(*),
67 . msp(*), dmelp(*),al(mvsiz)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I
72 my_real
73 . SSP(MVSIZ), DT(MVSIZ), DMP(MVSIZ), FAC(MVSIZ),
74 . A1, B1, B2, B3, YOUNG,G,AA,BB,
75 . PHI,SHF,DSH(MVSIZ),SL2I(MVSIZ),
76 . FACDT(MVSIZ),PHII(MVSIZ),CST,PHMAX,
77 . kphi(mvsiz),phmin,fsh(mvsiz)
78C-----------------------------------------------
79 dt(1:mvsiz) = zero
80!
81 DO i=1,nel
82 dmp(i)=max(geo(16,pid(i)),geo(17,pid(i)))
83 ENDDO
84!
85C----------------------------------------------
86C for new dt
87C----------------------------------------------
88 DO i=1,nel
89 young = pm(20,mat(i))
90 g = pm(22,mat(i))
91 cst = six_over_5*young/g
92 a1 =geo(1,pid(i))
93 b1 =geo(2,pid(i))
94 b2 =geo(18,pid(i))
95 bb = max(b1,b2,em30)
96 sl2i(i) = a1*al(i)**2 / bb
97 facdt(i) = one_over_12*sl2i(i)
98 phmax = cst/facdt(i)
99 phmin = min(b1,b2)*phmax/bb
100 kphi(i) = (four+phmin)/(one+phmin)
101 phii(i) = kphi(i)/(one+facdt(i))
102 phii(i) = max(one,phii(i))
103 fsh(i) = al(i)/(facdt(i)+cst)
104 fsh(i) = max(one,fsh(i))
105 ENDDO
106 IF (igtyp == 18) THEN
107 fsh(1:nel) = one
108 kphi(1:nel) = max(one,sl2i(1:nel))
109 END IF
110 IF (idtmins /= 2 .OR. jsms == 0) THEN
111 IF (nodadt /= 0 .OR. idtmins == 2) THEN
112 DO i=jft,jlt
113 sti(i) = zero
114 stir(i) = zero
115 ssp(i) =pm(27,mat(i))
116 fac(i)=zero
117 IF (offg(i) /= zero) THEN
118 young =pm(20,mat(i))
119 g =pm(22,mat(i))
120 a1 =geo(1,pid(i))
121 b1 =geo(2,pid(i))
122 b2 =geo(18,pid(i))
123 b3 =geo(4,pid(i))
124 dmp(i)=dmp(i)*sqrt(two)
125 aa =(sqrt(one +dmp(i)*dmp(i))-dmp(i))
126 aa = al(i) * aa * aa
127 bb = max(b1,b2)
128 stir(i) = max(g*b3,kphi(i)*young*bb) / aa
129 sti(i) = fsh(i)*a1 * young / aa
130 ENDIF ! IF (OFFG(I) /= ZERO)
131 ENDDO
132 IF (idtmin(5) == 0) RETURN
133 ELSE
134 DO i=jft,jlt
135 sti(i) = zero
136 stir(i) = zero
137 ssp(i) =pm(27,mat(i))
138 young =pm(20,mat(i))
139 a1 =geo(1,pid(i))
140 dmp(i)=dmp(i)*sqrt(two)
141 IF (offg(i) > zero) sti(i) = fsh(i)*a1 * young / al(i)
142 ENDDO
143 ENDIF ! IF (NODADT /= 0 .OR. IDTMINS == 2)
144 ELSE ! IF (IDTMINS /= 2 .OR. JSMS == 0)
145! IDTMINS=2 & JSMS=1 <=> AMS & elementary time step
146 DO i=jft,jlt
147 sti(i) = zero
148 stir(i) = zero
149 ssp(i) =pm(27,mat(i))
150 fac(i)=zero
151 IF (offg(i) /= zero) THEN
152 young =pm(20,mat(i))
153 g =pm(22,mat(i))
154 a1 =geo(1,pid(i))
155 b1 =geo(2,pid(i))
156 b2 =geo(18,pid(i))
157 b3 =geo(4,pid(i))
158 dmp(i)=dmp(i)*sqrt(two)
159 aa =(sqrt(one +dmp(i)*dmp(i))-dmp(i))
160 aa = al(i) * aa * aa
161 bb = max(b1,b2)
162 stir(i) = max(g*b3,four*young*bb) / aa
163 sti(i) = a1 * young / aa
164! calcul du pourcentage d'amortissement en cisaillement
165 sl2i(i)= a1*al(i)**2 / max(b1,b2,em30)
166 shf = one-geo(37,pid(i))
167 phi = twelve*young/(five/six*g)/max(em30,sl2i(i))
168 dsh(i) = dmp(i)
169 . *max(one,
170 . sqrt(twelve/max(em30,sl2i(i)))*sqrt(one+phi*shf))
171 aa = sqrt(one+dsh(i)*dsh(i))-dsh(i)
172 aa = al(i) * aa * aa
173 sti(i) = max(sti(i),twelve*bb*young/al(i)/al(i) / aa)
174 ENDIF ! IF (OFFG(I) /= ZERO)
175 ENDDO
176
177 DO i=jft,jlt
178 IF (offg(i) /= zero) THEN
179! DT(I) = DTFACS*
180! . SQRT(TWO*(MSP(I)+DMELP(I))/MAX(EM20,STI(I)))
181 dmelp(i)=max(dmelp(i),
182 . half*(dtmins/dtfacs)**2 * sti(i) - msp(i))
183 dt(i)=dtmins
184 IF (dt(i) < dt2t) THEN
185 dt2t = dt(i)
186 neltst = ngl(i)
187 ityptst = 5
188 ENDIF ! IF (DT(I) < DT2T)
189 ENDIF ! IF (OFFG(I) /= ZERO)
190 ENDDO
191!---
192 RETURN
193 ENDIF
194!
195 DO i=jft,jlt
196 fac(i) =sqrt(one+dmp(i)*dmp(i))-dmp(i)
197 dt(i)=dtfac1(5)*fac(i)*al(i)/ssp(i)/sqrt(fsh(i))
198 ENDDO ! DO I=JFT,JLT
199C
200 DO i=jft,jlt
201 IF (dt(i) < dtmin1(5) .AND. offg(i) == one) THEN
202 IF (idtmin(5) == 1 ) THEN
203 tstop = tt
204#include "lockon.inc"
205 WRITE(iout,*)
206 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
207 WRITE(istdo,*)
208 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
209#include "lockoff.inc"
210 ELSEIF (idtmin(5) == 2) THEN
211 offg(i)=zero
212#include "lockon.inc"
213 WRITE(iout,*) '-- DELETE OF BEAM ELEMENT NUMBER',ngl(i)
214#include "lockoff.inc"
215 idel7nok = 1
216 ELSEIF (idtmin(5) == 5) THEN
217 mstop = 2
218#include "lockon.inc"
219 WRITE(iout,*)
220 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
221 WRITE(istdo,*)
222 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR BEAM ELEMENT'
223#include "lockoff.inc"
224 ENDIF ! IF (IDTMIN(5) == 1 )
225 ENDIF ! IF (DT(I) < DTMIN1(5) .AND. OFFG(I) == ONE)
226 ENDDO ! DO I=JFT,JLT
227!
228 IF (nodadt /= 0) RETURN
229!
230 DO i=jft,jlt
231 IF (dt(i) < dt2t .and. offg(i) > zero) THEN
232 dt2t=dt(i)
233 neltst =ngl(i)
234 ityptst=5
235 ENDIF ! IF (DT(I) < DT2T .OR. OFFG(I) > ZERO)
236 ENDDO ! DO I=JFT,JLT
237C------------------------------
238 IF (g_dt /= zero) THEN
239 DO i=jft,jlt
240 dtel(i) = dt(i)
241 ENDDO
242 ENDIF
243C------------------------------
244 RETURN
245 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
pdlen3
subroutine pdlen3(jft, jlt, pm, geo, offg, dt2t, neltst, ityptst, sti, stir, msp, dmelp, g_dt, dtel, al, mat, pid, ngl, nel, igtyp, jsms)
Definition pdlen3.F:35