OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
laser2.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine laser2 (nl, n1, n2, ifunc, iafunc, las, xlas, x, elbuf_tab, pm, wa, iparg, ixq, tf, npf, wfext)
subroutine laser3 (nl, ifunc, las, xlas, x, elbuf_tab, pm, iparg, ixq, tf, npf, wfext)

Function/Subroutine Documentation

◆ laser2()

subroutine laser2 ( integer nl,
integer n1,
integer n2,
integer ifunc,
integer iafunc,
integer, dimension(2,*) las,
xlas,
x,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
pm,
wa,
integer, dimension(nparg,*) iparg,
integer, dimension(7,*) ixq,
tf,
integer, dimension(*) npf,
double precision, intent(inout) wfext )

Definition at line 34 of file laser2.F.

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 DE LA LUMIERE LASER DANS LE PLASMA BREMSTRALUNG
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 DE LA LUMIERE LASER DANS LA CIBLE => VAPORISATION
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 VITESSE DE VAPORISATION
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 PRESSION DE CIBLE
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 REFLEXION DU RAYON LASER
236C-------------------------
237C
238 DO il=nl,1,-1
239C-------------------------------------------------------------
240C ABSORPTION DE LA LUMIERE LASER DANS LE PLASMA BREMSTRALUNG
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
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
interp
subroutine interp(tf, tt, npoint, f, tg)
Definition interp.F:35
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
nl
character *2 function nl()
Definition message.F:2354

◆ laser3()

subroutine laser3 ( integer nl,
integer ifunc,
integer, dimension(2,*) las,
xlas,
x,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
pm,
integer, dimension(nparg,*) iparg,
integer, dimension(7,*) ixq,
tf,
integer, dimension(*) npf,
double precision, intent(inout) wfext )

Definition at line 269 of file laser2.F.

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