OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
init_qd.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!|| init_qd ../starter/source/fluid/init_qd.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_bem ../starter/source/loads/bem/hm_read_bem.f
27!||====================================================================
28 SUBROUTINE init_qd(IFLOW, IBUF, ELEM, X, XS, YS, ZS, XD, YD, ZD,
29 . RFLOW, NORMAL, TA, AF, COSG, DCP)
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "units_c.inc"
38C-----------------------------------------------
39C D u m m y A r g u m e n t s
40C-----------------------------------------------
41 INTEGER IFLOW(*), IBUF(*), ELEM(5,*)
42 my_real x(3,*), af(*), rflow(*), normal(3,*), ta(*), cosg(*), dcp(*)
43 my_real xs, ys, zs, xd, yd, zd
44C--------------------------------------------------------------
45C L o c a l V a r i a b l e s
46C--------------------------------------------------------------
47 INTEGER ILVOUT, NEL, IWAVE, FREESURF
48 INTEGER N1, N2, N3, N4, N5, NN1, NN2, NN3, NN4, IEL, JEL
49 my_real x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4,
50 . xp, yp, zp, x13, y13, z13, x24, y24, z24,
51 . nrx, nry, nrz, area2, dcs, ssp, wi(4,2),
52 . xc, yc, zc, dirx, diry, dirz
53C
54 ilvout = iflow(17)
55 nel = iflow(6)
56 iwave = iflow(22)
57 freesurf= iflow(25)
58C-------------------------------------------------------------------
59C Compute Area, Normal and Arrival Time
60C-------------------------------------------------------------------
61 wi(1,1)=fourth
62 wi(2,1)=fourth
63 wi(3,1)=fourth
64 wi(4,1)=fourth
65 wi(1,2)=third
66 wi(2,2)=third
67 wi(3,2)=one_over_6
68 wi(4,2)=one_over_6
69 ssp=rflow(2)
70 IF(iwave==1) THEN
71 xc =rflow(9)
72 yc =rflow(10)
73 zc =rflow(11)
74 dcs=rflow(12)
75 ELSEIF(iwave==2) THEN
76 dirx=rflow(9)
77 diry=rflow(10)
78 dirz=rflow(11)
79 ENDIF
80
81 DO iel=1,nel
82 n1=elem(1,iel)
83 n2=elem(2,iel)
84 n3=elem(3,iel)
85 n4=elem(4,iel)
86 n5=elem(5,iel)
87 nn1=ibuf(n1)
88 nn2=ibuf(n2)
89 nn3=ibuf(n3)
90 nn4=ibuf(n4)
91 x1=x(1,nn1)
92 x2=x(1,nn2)
93 x3=x(1,nn3)
94 x4=x(1,nn4)
95 y1=x(2,nn1)
96 y2=x(2,nn2)
97 y3=x(2,nn3)
98 y4=x(2,nn4)
99 z1=x(3,nn1)
100 z2=x(3,nn2)
101 z3=x(3,nn3)
102 z4=x(3,nn4)
103C Normale
104 x13=x3-x1
105 y13=y3-y1
106 z13=z3-z1
107 x24=x4-x2
108 y24=y4-y2
109 z24=z4-z2
110 nrx=y13*z24-z13*y24
111 nry=z13*x24-x13*z24
112 nrz=x13*y24-y13*x24
113 area2=sqrt(nrx**2+nry**2+nrz**2)
114 normal(1,iel)=nrx/area2
115 normal(2,iel)=nry/area2
116 normal(3,iel)=nrz/area2
117 af(iel)=half*area2
118C Centroid
119 xp=wi(1,n5)*x1+wi(2,n5)*x2+wi(3,n5)*x3+wi(4,n5)*x4
120 yp=wi(1,n5)*y1+wi(2,n5)*y2+wi(3,n5)*y3+wi(4,n5)*y4
121 zp=wi(1,n5)*z1+wi(2,n5)*z2+wi(3,n5)*z3+wi(4,n5)*z4
122C Arrival time
123 IF(iwave==1) THEN
124 dcp(iel) = sqrt((xp-xc)**2+(yp-yc)**2+(zp-zc)**2)
125 ta(iel) = (dcp(iel)-dcs)/ssp
126 cosg(iel)= (nrx*(xp-xc)+nry*(yp-yc)+nrz*(zp-zc))/(area2*dcp(iel))
127 IF(freesurf == 2) THEN
128 jel=iel+nel
129 dcp(jel) = sqrt((xp-xd)**2+(yp-yd)**2+(zp-zd)**2)
130 ta(jel) = (dcp(jel)-dcs)/ssp
131 cosg(jel)= (nrx*(xp-xd)+nry*(yp-yd)+nrz*(zp-zd))/(area2*dcp(jel))
132 ENDIF
133 ELSEIF(iwave==2) THEN
134 dcp(iel) = (xp-xs)*dirx+(yp-xs)*diry+(zp-zs)*dirz
135 ta(iel) = dcp(iel)/ssp
136 cosg(iel)= (nrx*dirx+nry*diry+nrz*dirz)/area2
137 ENDIF
138 ENDDO
139
140 IF(ilvout>=2) THEN
141C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----1----+----2----+----3--
142 WRITE (iout,'(//7X,2A)') 'ELEMENT ARRIVAL TIME AREA DISTANCE DIR.COSINE ',
143 . 'NORMAL-X NORMAL-Y NORMAL-Z'
144 DO iel = 1,nel
145 WRITE (iout,'(5X,I10,7E13.5)')iel,ta(iel),af(iel),dcp(iel),cosg(iel),normal(1,iel),normal(2,iel),normal(3,iel)
146 ENDDO
147 IF(freesurf == 2) THEN
148 WRITE (iout,'(//7X,2A)') 'ELEMENT ARRIVAL TIME AREA DISTANCE DIR.COSINE '
149 DO iel = 1,nel
150 jel=iel+nel
151 WRITE (iout,'(5X,I10,7E13.5)')iel,ta(jel),af(iel),dcp(jel),cosg(jel)
152 ENDDO
153 ENDIF
154 ENDIF
155
156 RETURN
157 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_bem
subroutine hm_read_bem(igrsurf, iflow, rflow, npc, igrnod, memflow, unitab, x, nom_opt, lgauge, igrv, lsubmodel, iresp)
Definition hm_read_bem.F:274
init_qd
subroutine init_qd(iflow, ibuf, elem, x, xs, ys, zs, xd, yd, zd, rflow, normal, ta, af, cosg, dcp)
Definition init_qd.F:30
starter
program starter
Definition starter.F:39