OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3fint_reg.F File Reference
#include "implicit_f.inc"
#include "parit_c.inc"
#include "com20_c.inc"
#include "com08_c.inc"
#include "scr02_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c3fint_reg (nloc_dmg, var_reg, thk, nel, off, area, nc1, nc2, nc3, px1, py1, py2, bufnl, imat, nddl, itask, dt2t, le, thk0, area0, nft)

Function/Subroutine Documentation

◆ c3fint_reg()

subroutine c3fint_reg ( type(nlocal_str_), target nloc_dmg,
intent(inout) var_reg,
intent(in) thk,
integer nel,
intent(in) off,
intent(in) area,
integer, dimension(nel) nc1,
integer, dimension(nel) nc2,
integer, dimension(nel) nc3,
intent(in) px1,
intent(in) py1,
intent(in) py2,
type(buf_nloc_), target bufnl,
integer imat,
integer nddl,
integer itask,
intent(inout) dt2t,
intent(in) le,
intent(in) thk0,
intent(in) area0,
integer, intent(in) nft )

Definition at line 31 of file c3fint_reg.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE nlocal_reg_mod
42 USE elbufdef_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "parit_c.inc"
51#include "com20_c.inc"
52#include "com08_c.inc"
53#include "scr02_c.inc"
54#include "scr18_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(IN) :: NFT
59 INTEGER :: NEL,IMAT,NDDL,ITASK
60 INTEGER, DIMENSION(NEL) :: NC1,NC2,NC3
61 my_real, DIMENSION(NEL,NDDL), INTENT(INOUT)::
62 . var_reg
63 my_real, DIMENSION(NEL), INTENT(IN) ::
64 . area,off,px1,py1,py2,thk,le,thk0,area0
65 my_real, INTENT(INOUT) ::
66 . dt2t
67 TYPE(NLOCAL_STR_), TARGET :: NLOC_DMG
68 TYPE(BUF_NLOC_) , TARGET :: BUFNL
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,K,N1,N2,N3,L_NLOC,II,J,NDNOD
73 my_real
74 . l2,ntn,ntn_unl,ntn_vnl,xi,ntvar,a,
75 . b1,b2,b3,zeta,sspnl,
76 . nth1,nth2,bth1,bth2,k1,k2,k12,
77 . dtnl_th,dtnl,le_max,maxstif,
78 . dtnod,dt2p
79 my_real, DIMENSION(:,:), ALLOCATABLE ::
80 . f1,f2,f3,sti1,sti2,sti3
81 my_real, DIMENSION(:) ,ALLOCATABLE ::
82 . btb11,btb12,btb13,btb22,btb23,btb33,vol
83 INTEGER, DIMENSION(:), ALLOCATABLE ::
84 . POS1,POS2,POS3
85 my_real, POINTER, DIMENSION(:) ::
86 . vnl,fnl,unl,stifnl,mass,mass0,vnl0
87 my_real, POINTER, DIMENSION(:,:) ::
88 . massth,unlth,vnlth,fnlth
89 my_real, DIMENSION(:,:), ALLOCATABLE ::
90 . stifnlth,dtn
91c-----------------------------------------------------------------------
92c VAR_REG : variable a regulariser (local cumulated plastic strain)
93c NTVAR = NT * VAR_REG
94C=======================================================================
95 ! Recovering non-local parameters
96 l2 = nloc_dmg%LEN(imat)**2 ! Non-local internal length ** 2
97 xi = nloc_dmg%DAMP(imat) ! Non-local damping parameter
98 zeta = nloc_dmg%DENS(imat) ! Non-local density
99 sspnl = nloc_dmg%SSPNL(imat) ! Non-local sound speed
100 l_nloc = nloc_dmg%L_NLOC ! Length of non-local tables
101 le_max = nloc_dmg%LE_MAX(imat) ! Maximal length of convergence
102 ! Allocation of elementary forces vectors
103 ALLOCATE(f1(nel,nddl),f2(nel,nddl),f3(nel,nddl))
104 ! Only for nodal timestep
105 IF (nodadt > 0) THEN
106 ! Non-local nodal stiffness
107 ALLOCATE(sti1(nel,nddl),sti2(nel,nddl),sti3(nel,nddl))
108 ! Non-local mass
109 mass => nloc_dmg%MASS(1:l_nloc)
110 ! Initial non-local mass
111 mass0 => nloc_dmg%MASS0(1:l_nloc)
112 ENDIF
113 ALLOCATE(btb11(nel),btb12(nel),btb13(nel),btb22(nel),
114 . btb23(nel),btb33(nel),vol(nel),pos1(nel),
115 . pos2(nel),pos3(nel))
116 ! Recovering non-local data
117 vnl => nloc_dmg%VNL(1:l_nloc) ! Non-local variable velocities
118 vnl0 => nloc_dmg%VNL_OLD(1:l_nloc) ! Non-local variable velocities
119 unl => nloc_dmg%UNL(1:l_nloc) ! Non-local cumulated variable
120 ! Constant for triangle elements
121 ntn = three*three
122c
123 !-----------------------------------------------------------------------
124 ! Computation of the element volume and the BtB matrix product
125 !-----------------------------------------------------------------------
126 ! Loop over elements
127# include "vectorize.inc"
128 DO i=1,nel
129c
130 ! Recovering the nodes of the triangle element
131 n1 = nloc_dmg%IDXI(nc1(i))
132 n2 = nloc_dmg%IDXI(nc2(i))
133 n3 = nloc_dmg%IDXI(nc3(i))
134c
135 ! Recovering the positions of the first d.o.fs of each nodes
136 pos1(i) = nloc_dmg%POSI(n1)
137 pos2(i) = nloc_dmg%POSI(n2)
138 pos3(i) = nloc_dmg%POSI(n3)
139c
140 ! Computation of the element volume
141 vol(i) = area(i)*thk(i)
142c
143 ! Computation of the product LEN**2 * BtxB
144 btb11(i) = px1(i)**2 + py1(i)**2
145 btb12(i) = -px1(i)**2 + py1(i)*py2(i)
146 btb13(i) = -py1(i)*(py1(i)+py2(i))
147 btb22(i) = px1(i)**2 + py2(i)**2
148 btb23(i) = -py2(i)*(py1(i)+py2(i))
149 btb33(i) = (py1(i)+py2(i))**2
150c
151 ENDDO
152c
153 !-----------------------------------------------------------------------
154 ! Pre-treatment con-local regularization in the thickness
155 !-----------------------------------------------------------------------
156 ! Only if NDDL > 1
157 IF ((nddl > 1).AND.(l2>zero)) THEN
158c
159 ! Allocation of the velocities predictor
160 IF (nddl > 2) THEN
161 IF (nodadt > 0) THEN
162 ALLOCATE(stifnlth(nel,nddl+1))
163 ALLOCATE(dtn(nel,nddl+1))
164 ENDIF
165 ndnod = nddl+1
166 ELSE
167 IF (nodadt > 0) THEN
168 ALLOCATE(stifnlth(nel,nddl))
169 ALLOCATE(dtn(nel,nddl))
170 ENDIF
171 ndnod = nddl
172 ENDIF
173c
174 ! Pointing the non-local values in the thickness of the corresponding element
175 massth => bufnl%MASSTH(1:nel,1:ndnod)
176 unlth => bufnl%UNLTH(1:nel ,1:ndnod)
177 vnlth => bufnl%VNLTH(1:nel ,1:ndnod)
178 fnlth => bufnl%FNLTH(1:nel ,1:ndnod)
179c
180 DO k = 1,ndnod
181 DO i = 1,nel
182 ! Resetting non-local forces
183 fnlth(i,k) = zero
184 ! Resetting non-local nodal stiffness
185 IF (nodadt > 0) THEN
186 stifnlth(i,k) = em20
187 ENDIF
188 ENDDO
189 ENDDO
190c
191 ! Computation of non-local forces in the shell thickness
192 DO k = 1, nddl
193c
194 ! Computation of shape functions value
195 IF ((nddl==2).AND.(k==2)) THEN
196 nth1 = (z0(k,nddl) - zth(k,nddl)) / (zth(k-1,nddl) - zth(k,nddl))
197 nth2 = (z0(k,nddl) - zth(k-1,nddl)) / (zth(k,nddl) - zth(k-1,nddl))
198 ELSE
199 nth1 = (z0(k,nddl) - zth(k+1,nddl)) / (zth(k,nddl) - zth(k+1,nddl))
200 nth2 = (z0(k,nddl) - zth(k,nddl)) / (zth(k+1,nddl) - zth(k,nddl))
201 ENDIF
202c
203 ! Loop over elements
204 DO i = 1,nel
205 ! Computation of B-matrix values
206 IF ((nddl==2).AND.(k==2)) THEN
207 bth1 = (one/(zth(k-1,nddl) - zth(k,nddl)))*(one/thk(i))
208 bth2 = (one/(zth(k,nddl) - zth(k-1,nddl)))*(one/thk(i))
209 ELSE
210 bth1 = (one/(zth(k,nddl) - zth(k+1,nddl)))*(one/thk(i))
211 bth2 = (one/(zth(k+1,nddl) - zth(k,nddl)))*(one/thk(i))
212 ENDIF
213c
214 ! Computation of the non-local K matrix
215 k1 = l2*(bth1**2) + nth1**2
216 k12 = l2*(bth1*bth2)+ (nth1*nth2)
217 k2 = l2*(bth2**2) + nth2**2
218c
219 ! Computation of the non-local forces
220 IF ((nddl==2).AND.(k==2)) THEN
221 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
222 . + xi*((nth1**2)*vnlth(i,k-1)
223 . + (nth1*nth2)*vnlth(i,k))
224 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
225 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
226 . + xi*(nth1*nth2*vnlth(i,k-1)
227 . + (nth2**2)*vnlth(i,k))
228 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
229 ELSE
230 fnlth(i,k) = fnlth(i,k) + (k1*unlth(i,k) + k12*unlth(i,k+1)
231 . + xi*((nth1**2)*vnlth(i,k)
232 . + (nth1*nth2)*vnlth(i,k+1))
233 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
234 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
235 . + xi*(nth1*nth2*vnlth(i,k)
236 . + (nth2**2)*vnlth(i,k+1))
237 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
238 ENDIF
239c
240 ! Computation of non-local nodal stiffness
241 IF (nodadt > 0) THEN
242 IF ((nddl==2).AND.(k==2)) THEN
243 stifnlth(i,k-1) = stifnlth(i,k-1) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
244 stifnlth(i,k) = stifnlth(i,k) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
245 ELSE
246 stifnlth(i,k) = stifnlth(i,k) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
247 stifnlth(i,k+1) = stifnlth(i,k+1) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
248 ENDIF
249 ENDIF
250c
251 ENDDO
252 ENDDO
253c
254 ! Updating non-local mass with /DT/NODA
255 IF (nodadt > 0) THEN
256C
257 ! Initial computation of the nodal timestep
258 dtnod = ep20
259 DO k = 1,ndnod
260 DO i = 1,nel
261 dtn(i,k) = dtfac1(11)*cdamp*sqrt(two * massth(i,k) / max(stifnlth(i,k),em20))
262 dtnod = min(dtn(i,k),dtnod)
263 ENDDO
264 ENDDO
265C
266 ! /DT/NODA/CSTX - Constant timestep with added mass
267 IF ((idtmin(11)==3).OR.(idtmin(11)==4).OR.(idtmin(11)==8)) THEN
268 ! Added mass computation if necessary
269 IF (dtnod < dtmin1(11)) THEN
270 DO k = 1,ndnod
271 DO i = 1,nel
272 IF (dtn(i,k) < dtmin1(11)) THEN
273 dt2p = dtmin1(11)/(dtfac1(11)*cdamp)
274 massth(i,k) = max(massth(i,k),csta*half*stifnlth(i,k)*dt2p*dt2p*onep00001)
275 ENDIF
276 ENDDO
277 ENDDO
278 dtnod = dtmin1(11)*(sqrt(csta))
279 ENDIF
280 ENDIF
281C
282 ! Classical nodal timestep check
283 IF (dtnod < dt2t) THEN
284 dt2t = min(dt2t,dtnod)
285 ENDIF
286 ENDIF
287c
288 DO k = 1,ndnod
289 DO i = 1,nel
290 ! Updating the non-local in-thickness velocities
291 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt12
292 ENDDO
293 ENDDO
294c
295 DO k = 1,ndnod
296 DO i = 1,nel
297 ! Computing the non-local in-thickness cumulated values
298 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt1
299 ENDDO
300 ENDDO
301c
302 ! Transfert at the integration point
303 DO k = 1, nddl
304 !Computation of shape functions value
305 IF ((nddl==2).AND.(k==2)) THEN
306 nth1 = (z0(k,nddl) - zth(k,nddl))/(zth(k-1,nddl) - zth(k,nddl))
307 nth2 = (z0(k,nddl) - zth(k-1,nddl)) /(zth(k,nddl) - zth(k-1,nddl))
308 ELSE
309 nth1 = (z0(k,nddl) - zth(k+1,nddl))/(zth(k,nddl) - zth(k+1,nddl))
310 nth2 = (z0(k,nddl) - zth(k,nddl)) /(zth(k+1,nddl) - zth(k,nddl))
311 ENDIF
312 ! Loop over elements
313 DO i = 1,nel
314 !Integration points non-local variables
315 IF ((nddl==2).AND.(k==2)) THEN
316 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k)
317 ELSE
318 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
319 ENDIF
320 ENDDO
321 ENDDO
322 ENDIF
323c
324 !-----------------------------------------------------------------------
325 ! Computation of the elementary non-local forces
326 !-----------------------------------------------------------------------
327 ! Loop over additional degrees of freedom
328 DO k = 1, nddl
329c
330 ! Loop over elements
331# include "vectorize.inc"
332 DO i = 1, nel
333c
334 ! If the element is not broken, normal computation
335 IF (off(i) /= zero) THEN
336 ! Computation of the product LEN**2 * BtxB
337 ! Warning: the derivatives of the shape function does not take into account the volume of the element.
338 ! That is why a factor (1/VOL**2) is added in B1, B2, B3.
339 b1 = (l2 / vol(i)) * wf(k,nddl)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
340 . + btb13(i)*unl(pos3(i)+k-1))
341c
342 b2 = (l2 / vol(i)) * wf(k,nddl)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
343 . + btb23(i)*unl(pos3(i)+k-1))
344c
345 b3 = (l2 / vol(i)) * wf(k,nddl)*(btb13(i)*unl(pos1(i)+k-1) + btb23(i)*unl(pos2(i)+k-1)
346 . + btb33(i)*unl(pos3(i)+k-1))
347c
348 ! Computing the product NtN*UNL
349 ntn_unl = (unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1))/ntn
350c
351 ! Computing the product XDAMP*NtN*VNL
352 ntn_vnl = (vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1))/ntn
353 IF (nodadt > 0) THEN
354 ntn_vnl = min(sqrt(mass(pos1(i)+k-1)/mass0(pos1(i)+k-1)),
355 . sqrt(mass(pos2(i)+k-1)/mass0(pos2(i)+k-1)),
356 . sqrt(mass(pos3(i)+k-1)/mass0(pos3(i)+k-1)))*ntn_vnl
357 ENDIF
358c
359 ! Multiplication by the volume of the element
360 ntn_unl = ntn_unl * vol(i) * wf(k,nddl)
361 ntn_vnl = ntn_vnl * xi * vol(i) * wf(k,nddl)
362c
363 ! Introducing the internal variable to be regularized
364 ntvar = var_reg(i,k)*third*vol(i)*wf(k,nddl)
365c
366 ! Computing the elementary non-local forces
367 a = ntn_unl + ntn_vnl - ntvar
368 f1(i,k) = a + b1
369 f2(i,k) = a + b2
370 f3(i,k) = a + b3
371c
372 ! Computing nodal equivalent stiffness
373 IF (nodadt > 0) THEN
374 sti1(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb11(i) + one/ntn*vol(i)) +
375 . abs((l2/vol(i))*btb12(i) + one/ntn*vol(i)) +
376 . abs((l2/vol(i))*btb13(i) + one/ntn*vol(i)))
377 sti2(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb12(i) + one/ntn*vol(i)) +
378 . abs((l2/vol(i))*btb22(i) + one/ntn*vol(i)) +
379 . abs((l2/vol(i))*btb23(i) + one/ntn*vol(i)))
380 sti3(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb13(i) + one/ntn*vol(i)) +
381 . abs((l2/vol(i))*btb23(i) + one/ntn*vol(i)) +
382 . abs((l2/vol(i))*btb33(i) + one/ntn*vol(i)))
383 ENDIF
384c
385 ! If the element is broken, the non-local wave is absorbed
386 ELSE
387 IF (nodadt > 0) THEN
388 ! Non-local absorbing forces
389 f1(i,k) = wf(k,nddl)*sqrt(mass(pos1(i)+k-1)/mass0(pos1(i)+k-1))*zeta*sspnl*
390 . half*(vnl(pos1(i)+k-1)+vnl0(pos1(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
391 f2(i,k) = wf(k,nddl)*sqrt(mass(pos2(i)+k-1)/mass0(pos2(i)+k-1))*zeta*sspnl*
392 . half*(vnl(pos2(i)+k-1)+vnl0(pos2(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
393 f3(i,k) = wf(k,nddl)*sqrt(mass(pos3(i)+k-1)/mass0(pos3(i)+k-1))*zeta*sspnl*
394 . half*(vnl(pos3(i)+k-1)+vnl0(pos3(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
395 ! Computing nodal equivalent stiffness
396 sti1(i,k) = em20
397 sti2(i,k) = em20
398 sti3(i,k) = em20
399 ELSE
400 ! Non-local absorbing forces
401 f1(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos1(i)+k-1)+vnl0(pos1(i)+k-1))*
402 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
403 f2(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos2(i)+k-1)+vnl0(pos2(i)+k-1))*
404 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
405 f3(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos3(i)+k-1)+vnl0(pos3(i)+k-1))*
406 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
407 ENDIF
408 ENDIF
409 ENDDO
410 ENDDO
411c
412 !-----------------------------------------------------------------------
413 ! Assembling of the non-local forces
414 !-----------------------------------------------------------------------
415c
416 ! If PARITH/OFF
417 IF (iparit == 0) THEN
418 ! Recovering non-local internal forces
419 fnl => nloc_dmg%FNL(1:l_nloc,itask+1) ! Non-local forces
420 IF (nodadt > 0) stifnl => nloc_dmg%STIFNL(1:l_nloc,itask+1) ! Non-local equivalent nodal stiffness
421 ! Loop over elements
422 DO i=1,nel
423 ! Loop over non-local degrees of freedom (do not switch the two loops)
424#include "vectorize.inc"
425 DO k = 1,nddl
426 ! Assembling non-local forces
427 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - f1(i,k)
428 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - f2(i,k)
429 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) - f3(i,k)
430 IF (nodadt > 0) THEN
431 ! Spectral radius of stiffness matrix
432 maxstif = max(sti1(i,k),sti2(i,k),sti3(i,k))
433 ! Computing nodal stiffness
434 stifnl(pos1(i)+k-1) = stifnl(pos1(i)+k-1) + maxstif
435 stifnl(pos2(i)+k-1) = stifnl(pos2(i)+k-1) + maxstif
436 stifnl(pos3(i)+k-1) = stifnl(pos3(i)+k-1) + maxstif
437 ENDIF
438 ENDDO
439 ENDDO
440c
441 ! If PARITH/ON
442 ELSE
443 ! Loop over additional d.o.fs
444 DO j = 1,nddl
445c
446 ! Loop over elements
447 DO i=1,nel
448 ii = i + nft
449c
450 ! Spectral radius of stiffness matrix
451 IF (nodadt > 0) THEN
452 maxstif = max(sti1(i,j),sti2(i,j),sti3(i,j))
453 ENDIF
454c
455 k = nloc_dmg%IADTG(1,ii)
456 nloc_dmg%FSKY(k,j) = -f1(i,j)
457 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
458c
459 k = nloc_dmg%IADTG(2,ii)
460 nloc_dmg%FSKY(k,j) = -f2(i,j)
461 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
462c
463 k = nloc_dmg%IADTG(3,ii)
464 nloc_dmg%FSKY(k,j) = -f3(i,j)
465 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
466c
467 ENDDO
468c
469 ENDDO
470 ENDIF
471c
472 !-----------------------------------------------------------------------
473 ! Computing non-local timestep
474 !-----------------------------------------------------------------------
475 IF (nodadt == 0) THEN
476 DO i = 1,nel
477 ! If the element is not broken, normal computation
478 IF (off(i)/=zero) THEN
479 ! Non-local critical time-step in the plane
480 dtnl = (two*(min(le(i),le_max))*sqrt(three*zeta))/
481 . sqrt(twelve*l2 + (min(le(i),le_max))**2)
482 ! Non-local critical time-step in the thickness
483 IF (nddl>1) THEN
484 IF (nddl > 2) THEN
485 dtnl_th = (two*(min(thk(i)/nddl,le_max))*sqrt(three*zeta))/
486 . sqrt(twelve*l2 + (min(thk(i)/nddl,le_max))**2)
487 ELSE
488 dtnl_th = (two*(min(thk(i),le_max))*sqrt(three*zeta))/
489 . sqrt(twelve*l2 + (min(thk(i),le_max))**2)
490 ENDIF
491 ELSE
492 dtnl_th = ep20
493 ENDIF
494 ! Retaining the minimal value
495 dt2t = min(dt2t,dtfac1(1)*cdamp*dtnl_th,dtfac1(1)*cdamp*dtnl)
496 ENDIF
497 ENDDO
498 ENDIF
499c
500 ! Deallocation of tables
501 IF (ALLOCATED(f1)) DEALLOCATE(f1)
502 IF (ALLOCATED(f2)) DEALLOCATE(f2)
503 IF (ALLOCATED(f3)) DEALLOCATE(f3)
504 IF (ALLOCATED(sti1)) DEALLOCATE(sti1)
505 IF (ALLOCATED(sti2)) DEALLOCATE(sti2)
506 IF (ALLOCATED(sti3)) DEALLOCATE(sti3)
507 IF (ALLOCATED(btb11)) DEALLOCATE(btb11)
508 IF (ALLOCATED(btb12)) DEALLOCATE(btb12)
509 IF (ALLOCATED(btb13)) DEALLOCATE(btb13)
510 IF (ALLOCATED(btb22)) DEALLOCATE(btb22)
511 IF (ALLOCATED(btb23)) DEALLOCATE(btb23)
512 IF (ALLOCATED(btb33)) DEALLOCATE(btb33)
513 IF (ALLOCATED(stifnlth)) DEALLOCATE(stifnlth)
514 IF (ALLOCATED(pos1)) DEALLOCATE(pos1)
515 IF (ALLOCATED(pos2)) DEALLOCATE(pos2)
516 IF (ALLOCATED(pos3)) DEALLOCATE(pos3)
517 IF (ALLOCATED(vol)) DEALLOCATE(vol)
518c
my_real
#define my_real
Definition cppsort.cpp:32
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
nlocal_reg_mod
Definition nlocal_reg_mod.F:119