OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ecran1.F File Reference
#include "implicit_f.inc"
#include "scr11_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ecran1 (detonator, x, vdet)

Function/Subroutine Documentation

◆ ecran1()

subroutine ecran1 ( type(detonator_wave_shaper_struct_), target detonator,
x,
intent(in) vdet )

Definition at line 35 of file ecran1.F.

36C-----------------------------------------------
37 USE message_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 my_real x(3,numnod)
47 my_real,INTENT(IN)::vdet
48 TYPE(DETONATOR_WAVE_SHAPER_STRUCT_),TARGET :: DETONATOR
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "scr11_c.inc"
53#include "com04_c.inc"
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I, II, J, JJ, JJJ,NPE
58 my_real dtomin, ddmx, d2
59 INTEGER,POINTER,DIMENSION(:) :: IECR, IORDR, IFLG
60 my_real,POINTER,DIMENSION(:) :: dtime
61C-----------------------------------------------
62C E x t e r n a l F u n c t i o n s
63C-----------------------------------------------
64 INTEGER,EXTERNAL :: IOMBR
65C-----------------------------------------------
66
67 npe=detonator%NUMNOD
68 iecr => detonator%NODES(1:)
69 iordr => detonator%IORDR(1:)
70 iflg => detonator%FLAG(1:)
71 dtime => detonator%TIME(1:)
72C---------------------------------------
73C COMPUTING DETONATION TIMES OF THE SCREEN POINTS
74C---------------------------------------
75C 1) LIGHTENING FROM DETONATION ORIGIN
76C check if the target can be directly lightened from detonation origin.
77C yes if no crossing with the screen (IOMBR returns 0)
78C no otherwise (IOMBR return 1)
79C---------------------------------------
80 dtomin=ep20
81 iordr(1)=0
82
83 DO i=1,npe
84 ddmx =ep20
85 iflg(i)=0
86 ii=iecr(i)
87 yl=x(2,ii)
88 zl=x(3,ii)
89 IF(iombr(detonator,x,iecr,ddmx,vdet) == 0)THEN !Vdet is optional velocity from origin (default is material velocity VDTO)
90 dtime(i)=dto !DT0 is lightening time from function IOMBR
91 IF(dtime(i) <= dtomin)THEN
92 iordr(1)=i
93 dtomin=dtime(i)
94 ENDIF
95 ELSE
96 dtime(i)=ep20
97 ENDIF
98 END DO !I=1,NPE
99
100 IF(iordr(1) == 0)THEN
101 CALL ancmsg(msgid=422,
102 . msgtype=msgerror,
103 . anmode=aninfo)
104 ENDIF
105
106C-----------------------------------------
107C 2) LIGHTENING SCREEN POINTS FROM SCREEN POINTS THEMSELVES
108C-----------------------------------------
109 DO j=1,npe-1
110 jj=iordr(j)
111 jjj=iecr(jj)
112 !define J as a new source. (J from N-1, N-2, ..., 1 ; first point is the nearest one from detonation origin)
113 yd=x(2,jjj)
114 zd=x(3,jjj)
115 dto0=dtime(jj)
116 iflg(jj)=1
117 dtomin=ep20
118 DO i=1,npe
119 ! check if I can be lightened from J (I from 1,2,...,N ; first node is the farthest one from detonation origin)
120 IF(iflg(i) == 1)cycle !I
121 ddmx =ep20
122 ii=iecr(i)
123 yl=x(2,ii)
124 zl=x(3,ii)
125 IF(iabs(i-jj) == 1)THEN
126 d2 =(yd-yl)**2+(zd-zl)**2
127 dto=dto0+sqrt(d2)/vdto
128 dtime(i)= min(dtime(i),dto)
129 ELSEIF(iombr(detonator,x,iecr,ddmx,vdto) == 0)THEN
130 dtime(i)= min(dtime(i),dto)
131 ENDIF
132 IF(dtime(i) <= dtomin)THEN
133 iordr(j+1)=i
134 dtomin=dtime(i)
135 ENDIF
136 END DO !I=1,NPE
137 END DO !J=1,NPE-1
138
139 RETURN
#define my_real
Definition cppsort.cpp:32
integer function iombr(detonator_wave_shaper, x, iecr, ddmx, vdet_arg)
Definition iombr.F:32
#define min(a, b)
Definition macros.h:20
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889