OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
laser2.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!|| laser2 ../engine/source/loads/laser/laser2.F
25!||--- called by ------------------------------------------------------
26!|| laser1 ../engine/source/loads/laser/laser1.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| interp ../engine/source/tools/curve/interp.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!||====================================================================
34 SUBROUTINE laser2(NL ,N1 ,N2 ,IFUNC ,IAFUNC ,
35 . LAS ,XLAS ,X ,ELBUF_TAB,PM ,
36 . WA ,IPARG,IXQ ,TF ,NPF ,
37 . WFEXT)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE initbuf_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 C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com06_c.inc"
52#include "com08_c.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER NL, N1, N2, IFUNC, IAFUNC
58 INTEGER LAS(2,*), IPARG(NPARG,*), IXQ(7,*), NPF(*)
59 my_real XLAS(*),X(3,*),WA(3,*),TF(*),PM(NPROPM,*)
60 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
61 DOUBLE PRECISION, INTENT(INOUT) :: WFEXT
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER IL, NG, I, NEL, NFT, II, NP1, NPOINT, IC, NELC, NB1C, NFTC, M4C, M13C,MX, M11C
66 INTEGER MTN,IAD,ITY,NPT,JALE,ISMSTR,
67 . JEUL,JTUR,JTHE,JLAG,NVAUX,JMULT,JHBE,JIVF,JPOR,JPLA,JCLOSE,
68 . irep,iint,igtyp,jcvt,isrot,israt,isorth,isorthg,icsen,ifailure,
69 . jsms
70 my_real
71 . chaleur, fi, alpha, z1, z2, z3, z4, zz, t, ddfi,
72 . dfi, de, bid, rhoc, c0, zm, zmc, y1, y2, y3, y4,
73 . d, vm, dar, fi0, vol, xkzz, rhoa2, rho0,
74 . a1,a2,aire,atom,af,tc, dfi1, xk0,hnuk,xk,rho,z,te,tscal,fifun
75 TYPE(g_bufel_) ,POINTER :: GBUF
76 TYPE(L_BUFEL_) ,POINTER :: LBUF
77C-----------------------------------------------
78 chaleur = xlas(1)
79 fi = xlas(2)
80 alpha = xlas(3)
81 xk0 = xlas(4)
82 hnuk = xlas(5)
83 dar = xlas(6)
84 tscal = xlas(7)
85C
86 IF(ifunc > 0) THEN
87 tscal = tscal*tt
88 npoint = (npf(ifunc+1)-npf(ifunc))/2
89 CALL interp(tf(npf(ifunc)),tscal,npoint,fifun,bid)
90 fi = fi * fifun
91 ENDIF
92 fi0 = fi
93C
94 i = 1
95 mx = 1
96 NULLIFY(gbuf)
97 te =zero
98 tscal = zero
99 vol = zero
100 z1 = zero
101 z2 = zero
102 z3 = zero
103 z4 = zero
104 zz = zero
105 jsms = 0
106C------------------------------------------------------------
107 DO 200 il=1,nl
108 ng = las(1,il)
109 i = las(2,il)
110 gbuf => elbuf_tab(ng)%GBUF
111 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
112
113 CALL initbuf(
114 1 iparg ,ng ,
115 2 mtn ,nel ,nft ,iad ,ity ,
116 3 npt ,jale ,ismstr ,jeul ,jtur ,
117 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
118 5 nvaux ,jpor ,jcvt ,jclose ,jpla ,
119 6 irep ,iint ,igtyp ,israt ,isrot ,
120 7 icsen ,isorth ,isorthg ,ifailure,jsms )
121
122 ii = i + nft
123 z1 = x(3,ixq(2,ii))
124 z2 = x(3,ixq(3,ii))
125 z3 = x(3,ixq(4,ii))
126 z4 = x(3,ixq(5,ii))
127 zz = half * (abs(z1 - z3) + abs(z2 - z4))
128C-------------------------------------------------------------
129C absorption of laser light in the plasma bremsstrahlung
130C-------------------------------------------------------------
131 rho = gbuf%RHO(i)
132 vol = gbuf%VOL(i)
133 te = gbuf%TEMP(i)
134 z = lbuf%Z(i)
135 mx = ixq(1,ii)
136 atom = pm(37,mx)
137 rho0 = pm(1,mx)
138C
139 rhoa2 = (rho/atom)**2
140 xk = xk0 * rhoa2 * (z / hnuk)**3 / sqrt(te)
141 xkzz = xk * (one - exp(-hnuk/te)) * zz
142 rhoa2 = ((rho-rho0)/atom)**2
143 IF(te<=ep04) xkzz = xkzz + dar * rhoa2 * zz
144C
145 ddfi = (one - exp(-xkzz))
146 dfi = fi * ddfi
147 fi = fi - dfi
148 de = dfi * dt2 / zz
149C
150 gbuf%EINT(i) = gbuf%EINT(i) + de
151 wfext = wfext + de * vol
152C
153 wa(1,il) = zz
154 wa(2,il) = ddfi
155C
156 200 CONTINUE
157C
158C-------------------------------------------------------------
159C absorption of laser light in the target => vaporization
160C-------------------------------------------------------------
161C
162 IF(iafunc>0)THEN
163 np1 = npf(iafunc)
164 npoint =(npf(iafunc+1)-np1)/2
165 t = te*tscal
166 CALL interp(tf(np1),t,npoint,af,bid)
167 alpha = alpha * af
168 ENDIF
169 dfi = alpha * fi
170 fi = fi - dfi
171 de = dfi * dt2 / zz
172C
173 gbuf%EINT(i) = gbuf%EINT(i) + de
174 wfext = wfext + de * vol
175C-------------------------
176C vaporization velocity
177C-------------------------
178 il = nl+1
179 ng = las(1,il)
180 ic = las(2,il)
181c
182 gbuf => elbuf_tab(ng)%GBUF
183c
184 nelc = iparg(2,ng)
185 nb1c = iparg(4,ng)
186 nftc = iparg(3,ng)
187 ii = ic + nftc
188 m4c = nb1c+8*nelc+ic-1
189 m11c = nb1c+12*nelc+ic-1
190 m13c = nb1c+14*nelc+ic-1
191
192 rhoc = gbuf%RHO(ic)
193 c0 = gbuf%EPSD(ic)
194
195 zm = z1 + z2 + z3 + z4
196 z1 = x(3,ixq(2,ii))
197 z2 = x(3,ixq(3,ii))
198 z3 = x(3,ixq(4,ii))
199 z4 = x(3,ixq(5,ii))
200 zmc = z1 + z2 + z3 + z4
201 y1 = x(2,ixq(2,ii))
202 y2 = x(2,ixq(3,ii))
203 y3 = x(2,ixq(4,ii))
204 y4 = x(2,ixq(5,ii))
205 a1 = y2*(z3-z4)+y3*(z4-z2)+y4*(z2-z3)
206 a2 = y2*(z4-z1)+y4*(z1-z2)+y1*(z2-z4)
207 aire = (a1+a2)/two
208
209 tc = gbuf%TEMP(ic)
210 dfi1 = pm(75,mx) * (two*(te - tc)/zz) / dt2
211
212 d = (dfi+dfi1) / (rhoc*chaleur)
213
214 vm = d * aire * rhoc * fourth
215 IF(zmc>zm) vm = -vm
216 wa(3,n1) = wa(3,n1) + vm
217 wa(3,n2) = wa(3,n2) + vm
218C-------------------------
219C target pressure
220C-------------------------
221c NB2 = NB1+NEL
222c M2 = NB2+6*I-6
223c SY = BUFEL(M2)
224c SZ = BUFEL(M2+1)
225c SX = BUFEL(M2+2)
226c P = -(SX+SY+SZ) * THIRD
227c DP = RHOC*C0*D
228c DP = MIN(DP,P)
229c DP = MAX(DP,ZERO)
230c SX = -P + DP * HALF
231c SY = -P + DP * HALF
232c SZ = -P - DP
233C
234C-------------------------
235C reflection of the laser beam
236C-------------------------
237C
238 DO il=nl,1,-1
239C-------------------------------------------------------------
240C absorption of laser light in the plasma bremsstrahlung
241C-------------------------------------------------------------
242 ng = las(1,il)
243 i = las(2,il)
244 gbuf => elbuf_tab(ng)%GBUF
245 zz = wa(1,il)
246 ddfi = wa(2,il)
247 dfi = fi * ddfi
248 fi = fi - dfi
249 de = dfi * dt2 / zz
250 gbuf%EINT(i) = gbuf%EINT(i) + de
251 vol = gbuf%VOL(i)
252 wfext = wfext + de * vol
253 ENDDO
254C-------------------------
255 RETURN
256 END
257C
258!||====================================================================
259!|| laser3 ../engine/source/loads/laser/laser2.F
260!||--- called by ------------------------------------------------------
261!|| laser1 ../engine/source/loads/laser/laser1.F
262!||--- calls -----------------------------------------------------
263!|| initbuf ../engine/share/resol/initbuf.F
264!|| interp ../engine/source/tools/curve/interp.F
265!||--- uses -----------------------------------------------------
266!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
267!|| initbuf_mod ../engine/share/resol/initbuf.F
268!||====================================================================
269 SUBROUTINE laser3(NL ,IFUNC ,
270 . LAS ,XLAS ,X ,ELBUF_TAB ,PM ,
271 . IPARG,IXQ ,TF ,NPF ,WFEXT )
272C-----------------------------------------------
273C M o d u l e s
274C-----------------------------------------------
275 USE initbuf_mod
276 USE elbufdef_mod
277C-----------------------------------------------
278C I m p l i c i t T y p e s
279C-----------------------------------------------
280#include "implicit_f.inc"
281C-----------------------------------------------
282C C o m m o n B l o c k s
283C-----------------------------------------------
284#include "com01_c.inc"
285#include "com06_c.inc"
286#include "com08_c.inc"
287#include "param_c.inc"
288C-----------------------------------------------
289C D u m m y A r g u m e n t s
290C-----------------------------------------------
291 INTEGER NL, IFUNC
292 INTEGER LAS(2,*), IPARG(NPARG,*), IXQ(7,*), NPF(*)
293 my_real
294 . XLAS(*),X(3,*),TF(*),PM(NPROPM,*)
295 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
296 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
297C-----------------------------------------------
298C L o c a l V a r i a b l e s
299C-----------------------------------------------
300 INTEGER IL, NG, I, NEL, NFT, II,
301 . npoint,
302 . mx
303 INTEGER MTN,IAD,ITY,NPT,JALE,ISMSTR,
304 . JEUL,JTUR,JTHE,JLAG,NVAUX,JMULT,JHBE,JIVF,JPOR,JPLA,JCLOSE,
305 . irep,iint,igtyp,jcvt,isrot,israt,isorth,isorthg,icsen,ifailure,
306 . jsms
307 my_real
308 . fi, z1, z2, z3, z4, zz,
309 . dfi, de, bid, y1, y2, y3, y4,
310 . vol, rho0,
311 . tscal,fifun,
312 . rho,te,enerlim,ener
313 TYPE(g_bufel_) ,POINTER :: GBUF
314C=======================================================================
315 ENERLIM = xlas(1)
316 fi = xlas(2)
317 tscal = xlas(7)
318C
319 IF(ifunc > 0) THEN
320 tscal = tscal*tt
321 npoint=(npf(ifunc+1)-npf(ifunc))/2
322 CALL interp(tf(npf(ifunc)),tscal,npoint,fifun,bid)
323 fi = fi * fifun
324 ENDIF
325C
326 jsms = 0
327 dfi = zero
328C-------------------------------------------------------------
329 DO il=1,nl
330 ng = las(1,il)
331 i = las(2,il)
332 gbuf => elbuf_tab(ng)%GBUF
333 CALL initbuf(iparg ,ng ,
334 2 mtn ,nel ,nft ,iad ,ity ,
335 3 npt ,jale ,ismstr ,jeul ,jtur ,
336 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
337 5 nvaux ,jpor ,jcvt ,jclose ,jpla ,
338 6 irep ,iint ,igtyp ,israt ,isrot ,
339 7 icsen ,isorth ,isorthg ,ifailure,jsms )
340 ii = i + nft
341 mx = ixq(1,ii)
342 ener = gbuf%EINT(i)
343 rho = gbuf%RHO(i)
344 vol = gbuf%VOL(i)
345 te = gbuf%TEMP(i)
346 rho0 = pm(1,mx)
347 IF(ener<enerlim)THEN
348 z1 = x(3,ixq(2,ii))
349 z2 = x(3,ixq(3,ii))
350 z3 = x(3,ixq(4,ii))
351 z4 = x(3,ixq(5,ii))
352 y1 = x(2,ixq(2,ii))
353 y2 = x(2,ixq(3,ii))
354 y3 = x(2,ixq(4,ii))
355 y4 = x(2,ixq(5,ii))
356 zz = half * (abs(z1 - z3) + abs(z2 - z4))
357 de = dfi * dt2 / zz !warning DFI is zero : need to be validated, may be wrong
358 gbuf%EINT(i) = gbuf%EINT(i) + de
359 wfext = wfext + de * vol
360 EXIT !and return
361 ENDIF
362 ENDDO
363C-----------
364 RETURN
365 END
366
alpha
#define alpha
Definition eval.h:35
interp
subroutine interp(tf, tt, npoint, f, tg)
Definition interp.F:35
laser3
subroutine laser3(nl, ifunc, las, xlas, x, elbuf_tab, pm, iparg, ixq, tf, npf, wfext)
Definition laser2.F:272
laser2
subroutine laser2(nl, n1, n2, ifunc, iafunc, las, xlas, x, elbuf_tab, pm, wa, iparg, ixq, tf, npf, wfext)
Definition laser2.F:38
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261