OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdk6fint_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 cdk6fint_reg (nloc_dmg, var_reg, thk, nel, off, area, nc1, nc2, nc3, px2, py2, px3, py3, bufnl, imat, nddl, itask, dt2t, le, thk0, area0, nft)

Function/Subroutine Documentation

◆ cdk6fint_reg()

subroutine cdk6fint_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) px2,
intent(in) py2,
intent(in) px3,
intent(in) py3,
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 cdk6fint_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,px2,py2,px3,py3,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
91 ! Safety coefficient for non-local stability vs mechanical stability
92 ! (it has been slightly increased vs nloc_dmg_init.F)
93 my_real, PARAMETER :: csta = 40.0d0
94 ! Coefficient for non-local stability to take into account damping
95 my_real, PARAMETER :: cdamp = 0.7d0
96c-----------------------------------------------------------------------
97c VAR_REG : variable a regulariser (local cumulated plastic strain)
98c NTVAR = NT * VAR_REG
99C=======================================================================
100 ! Recovering non-local parameters
101 l2 = nloc_dmg%LEN(imat)**2 ! Non-local internal length ** 2
102 xi = nloc_dmg%DAMP(imat) ! Non-local damping parameter
103 zeta = nloc_dmg%DENS(imat) ! Non-local density
104 sspnl = nloc_dmg%SSPNL(imat) ! Non-local sound speed
105 l_nloc = nloc_dmg%L_NLOC ! Length of non-local tables
106 le_max = nloc_dmg%LE_MAX(imat) ! Maximal length of convergence
107 ! Allocation of elementary forces vectors
108 ALLOCATE(f1(nel,nddl),f2(nel,nddl),f3(nel,nddl))
109 ! Only for nodal timestep
110 IF (nodadt > 0) THEN
111 ! Non-local nodal stiffness
112 ALLOCATE(sti1(nel,nddl),sti2(nel,nddl),sti3(nel,nddl))
113 ! Non-local mass
114 mass => nloc_dmg%MASS(1:l_nloc)
115 ! Initial non-local mass
116 mass0 => nloc_dmg%MASS0(1:l_nloc)
117 ENDIF
118 ALLOCATE(btb11(nel),btb12(nel),btb13(nel),btb22(nel),
119 . btb23(nel),btb33(nel),vol(nel),pos1(nel),
120 . pos2(nel),pos3(nel))
121 ! Recovering non-local data
122 vnl => nloc_dmg%VNL(1:l_nloc) ! Non-local variable velocities
123 vnl0 => nloc_dmg%VNL_OLD(1:l_nloc) ! Non-local variable velocities
124 unl => nloc_dmg%UNL(1:l_nloc) ! Non-local cumulated variable
125 ! Constant for triangle elements
126 ntn = three*three
127c
128 !-----------------------------------------------------------------------
129 ! Computation of the element volume and the BtB matrix product
130 !-----------------------------------------------------------------------
131 ! Loop over elements
132# include "vectorize.inc"
133 DO i=1,nel
134c
135 ! Recovering the nodes of the triangle element
136 n1 = nloc_dmg%IDXI(nc1(i))
137 n2 = nloc_dmg%IDXI(nc2(i))
138 n3 = nloc_dmg%IDXI(nc3(i))
139c
140 ! Recovering the positions of the first d.o.fs of each nodes
141 pos1(i) = nloc_dmg%POSI(n1)
142 pos2(i) = nloc_dmg%POSI(n2)
143 pos3(i) = nloc_dmg%POSI(n3)
144c
145 ! Computation of the element volume
146 vol(i) = area(i)*thk(i)
147c
148 ! Computation of the product BtxB
149 btb11(i) = (-px3(i)-px2(i))**2 + (-py2(i)-py3(i))**2
150 btb12(i) = (-px3(i)-px2(i))*px2(i) + (-py2(i)-py3(i))*py2(i)
151 btb13(i) = (-px3(i)-px2(i))*px3(i) + (-py2(i)-py3(i))*py3(i)
152 btb22(i) = px2(i)**2 + py2(i)**2
153 btb23(i) = px2(i)*px3(i) + py2(i)*py3(i)
154 btb33(i) = px3(i)**2 + py3(i)**2
155c
156 ENDDO
157c
158 !-----------------------------------------------------------------------
159 ! Pre-treatment non-local regularization in the thickness
160 !-----------------------------------------------------------------------
161 ! Only if NDDL > 1
162 IF ((nddl > 1).AND.(l2>zero)) THEN
163c
164 ! Allocation of the velocities predictor
165 IF (nddl > 2) THEN
166 IF (nodadt > 0) THEN
167 ALLOCATE(stifnlth(nel,nddl+1))
168 ALLOCATE(dtn(nel,nddl+1))
169 ENDIF
170 ndnod = nddl+1
171 ELSE
172 IF (nodadt > 0) THEN
173 ALLOCATE(stifnlth(nel,nddl))
174 ALLOCATE(dtn(nel,nddl))
175 ENDIF
176 ndnod = nddl
177 ENDIF
178c
179 ! Pointing the non-local values in the thickness of the corresponding element
180 massth => bufnl%MASSTH(1:nel,1:ndnod)
181 unlth => bufnl%UNLTH(1:nel,1:ndnod)
182 vnlth => bufnl%VNLTH(1:nel,1:ndnod)
183 fnlth => bufnl%FNLTH(1:nel,1:ndnod)
184c
185 DO k = 1,ndnod
186 DO i = 1,nel
187 ! Resetting non-local forces
188 fnlth(i,k) = zero
189 ! Resetting non-local nodal stiffness
190 IF (nodadt > 0) THEN
191 stifnlth(i,k) = em20
192 ENDIF
193 ENDDO
194 ENDDO
195c
196 ! Computation of non-local forces in the shell thickness
197 DO k = 1, nddl
198c
199 ! Computation of shape functions value
200 IF ((nddl==2).AND.(k==2)) THEN
201 nth1 = (z0(k,nddl) - zth(k,nddl)) / (zth(k-1,nddl) - zth(k,nddl))
202 nth2 = (z0(k,nddl) - zth(k-1,nddl)) / (zth(k,nddl) - zth(k-1,nddl))
203 ELSE
204 nth1 = (z0(k,nddl) - zth(k+1,nddl)) / (zth(k,nddl) - zth(k+1,nddl))
205 nth2 = (z0(k,nddl) - zth(k,nddl)) / (zth(k+1,nddl) - zth(k,nddl))
206 ENDIF
207c
208 ! Loop over elements
209 DO i = 1,nel
210 ! computation of b-matrix values
211 IF ((nddl==2).AND.(k==2)) THEN
212 bth1 = (one/(zth(k-1,nddl) - zth(k,nddl)))*(one/thk(i))
213 bth2 = (one/(zth(k,nddl) - zth(k-1,nddl)))*(one/thk(i))
214 ELSE
215 bth1 = (one/(zth(k,nddl) - zth(k+1,nddl)))*(one/thk(i))
216 bth2 = (one/(zth(k+1,nddl) - zth(k,nddl)))*(one/thk(i))
217 ENDIF
218c
219 ! Computation of the non-local K matrix
220 k1 = l2*(bth1**2) + nth1**2
221 k12 = l2*(bth1*bth2)+ (nth1*nth2)
222 k2 = l2*(bth2**2) + nth2**2
223c
224 ! Computation of the non-local forces
225 IF ((nddl==2).AND.(k==2)) THEN
226 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
227 . + xi*((nth1**2)*vnlth(i,k-1)
228 . + (nth1*nth2)*vnlth(i,k))
229 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
230 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
231 . + xi*(nth1*nth2*vnlth(i,k-1)
232 . + (nth2**2)*vnlth(i,k))
233 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
234 ELSE
235 fnlth(i,k) = fnlth(i,k) + (k1*unlth(i,k) + k12*unlth(i,k+1)
236 . + xi*((nth1**2)*vnlth(i,k)
237 . + (nth1*nth2)*vnlth(i,k+1))
238 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
239 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
240 . + xi*(nth1*nth2*vnlth(i,k)
241 . + (nth2**2)*vnlth(i,k+1))
242 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
243 ENDIF
244c
245 ! Computation of non-local nodal stiffness
246 IF (nodadt > 0) THEN
247 IF ((nddl==2).AND.(k==2)) THEN
248 stifnlth(i,k-1) = stifnlth(i,k-1) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
249 stifnlth(i,k) = stifnlth(i,k) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
250 ELSE
251 stifnlth(i,k) = stifnlth(i,k) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
252 stifnlth(i,k+1) = stifnlth(i,k+1) + max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
253 ENDIF
254 ENDIF
255c
256 ENDDO
257 ENDDO
258c
259 ! Updating non-local mass with /DT/NODA
260 IF (nodadt > 0) THEN
261C
262 ! Initial computation of the nodal timestep
263 dtnod = ep20
264 DO k = 1,ndnod
265 DO i = 1,nel
266 dtn(i,k) = dtfac1(11)*cdamp*sqrt(two*massth(i,k)/max(stifnlth(i,k),em20))
267 dtnod = min(dtn(i,k),dtnod)
268 ENDDO
269 ENDDO
270C
271 ! /DT/NODA/CSTX - Constant timestep with added mass
272 IF ((idtmin(11)==3).OR.(idtmin(11)==4).OR.(idtmin(11)==8)) THEN
273 ! Added mass computation if necessary
274 IF (dtnod < dtmin1(11)*(sqrt(csta))) THEN
275 DO k = 1,ndnod
276 DO i = 1,nel
277 IF (dtn(i,k) < dtmin1(11)) THEN
278 dt2p = dtmin1(11)/(dtfac1(11)*cdamp)
279 massth(i,k) = max(massth(i,k),csta*half*stifnlth(i,k)*dt2p*dt2p*onep00001)
280 ENDIF
281 ENDDO
282 ENDDO
283 ENDIF
284 dtnod = dtmin1(11)*(sqrt(csta))
285 ENDIF
286C
287 ! Classical nodal timestep check
288 IF (dtnod < dt2t) THEN
289 dt2t = min(dt2t,dtnod)
290 ENDIF
291 ENDIF
292c
293 DO k = 1,ndnod
294 DO i = 1,nel
295 ! Updating the non-local in-thickness velocities
296 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt12
297 ENDDO
298 ENDDO
299c
300 DO k = 1,ndnod
301 DO i = 1,nel
302 ! Computing the non-local in-thickness cumulated values
303 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt1
304 ENDDO
305 ENDDO
306c
307 ! Transfert at the integration point
308 DO k = 1, nddl
309 !Computation of shape functions value
310 IF ((nddl==2).AND.(k==2)) THEN
311 nth1 = (z0(k,nddl) - zth(k,nddl))/(zth(k-1,nddl) - zth(k,nddl))
312 nth2 = (z0(k,nddl) - zth(k-1,nddl)) /(zth(k,nddl) - zth(k-1,nddl))
313 ELSE
314 nth1 = (z0(k,nddl) - zth(k+1,nddl))/(zth(k,nddl) - zth(k+1,nddl))
315 nth2 = (z0(k,nddl) - zth(k,nddl)) /(zth(k+1,nddl) - zth(k,nddl))
316 ENDIF
317 ! Loop over elements
318 DO i = 1,nel
319 !Integration points non-local variables
320 IF ((nddl==2).AND.(k==2)) THEN
321 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k)
322 ELSE
323 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
324 ENDIF
325 ENDDO
326 ENDDO
327 ENDIF
328c
329 !-----------------------------------------------------------------------
330 ! Computation of the elementary non-local forces
331 !-----------------------------------------------------------------------
332 ! Loop over additional degrees of freedom
333 DO k = 1, nddl
334c
335 ! Loop over elements
336# include "vectorize.inc"
337 DO i=1,nel
338c
339 ! If the element is not broken, normal computation
340 IF (off(i)/=zero) THEN
341 ! Computation of the product LEN**2 * BtxB
342 b1 = (l2 * vol(i)) * wf(k,nddl)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
343 . + btb13(i)*unl(pos3(i)+k-1))
344c
345 b2 = (l2 * vol(i)) * wf(k,nddl)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
346 . + btb23(i)*unl(pos3(i)+k-1))
347c
348 b3 = (l2 * vol(i)) * wf(k,nddl)*(btb13(i)*unl(pos1(i)+k-1) + btb23(i)*unl(pos2(i)+k-1)
349 . + btb33(i)*unl(pos3(i)+k-1))
350c
351 ! Computing the product NtN*UNL
352 ntn_unl = (unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1))/ntn
353c
354 ! Computing the product XDAMP*NtN*VNL
355 ntn_vnl = (vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1))/ntn
356 IF (nodadt > 0) THEN
357 ntn_vnl = min(sqrt(mass(pos1(i)+k-1)/mass0(pos1(i)+k-1)),
358 . sqrt(mass(pos2(i)+k-1)/mass0(pos2(i)+k-1)),
359 . sqrt(mass(pos3(i)+k-1)/mass0(pos3(i)+k-1)))*ntn_vnl
360 ENDIF
361c
362 ! Multiplication by the volume of the element
363 ntn_unl = ntn_unl * vol(i) * wf(k,nddl)
364 ntn_vnl = ntn_vnl * xi * vol(i) * wf(k,nddl)
365c
366 ! Introducing the internal variable to be regularized
367 ntvar = var_reg(i,k)*third*vol(i)*wf(k,nddl)
368c
369 ! Computing the elementary non-local forces
370 a = ntn_unl + ntn_vnl - ntvar
371 f1(i,k) = a + b1
372 f2(i,k) = a + b2
373 f3(i,k) = a + b3
374c
375 ! Computing nodal equivalent stiffness
376 IF (nodadt > 0) THEN
377 sti1(i,k) = (abs(l2*btb11(i) + one/ntn) + abs(l2*btb12(i) + one/ntn) +
378 . abs(l2*btb13(i) + one/ntn))* vol(i) * wf(k,nddl)
379 sti2(i,k) = (abs(l2*btb12(i) + one/ntn) + abs(l2*btb22(i) + one/ntn) +
380 . abs(l2*btb23(i) + one/ntn))* vol(i) * wf(k,nddl)
381 sti3(i,k) = (abs(l2*btb13(i) + one/ntn) + abs(l2*btb23(i) + one/ntn) +
382 . abs(l2*btb33(i) + one/ntn))* vol(i) * wf(k,nddl)
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 stiffnes
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)
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:117