OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
volum0.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!|| volum0 ../engine/source/airbag/volum0.F
25!||--- calls -----------------------------------------------------
26!|| spmd_exch_fr6 ../engine/source/mpi/kinematic_conditions/spmd_exch_fr6.F
27!|| sum_6_float ../engine/source/system/parit.F
28!||--- uses -----------------------------------------------------
29!|| monvol_struct_mod ../engine/share/modules/monvol_struct_mod.F
30!||====================================================================
31 SUBROUTINE volum0(IVOLU ,RVOLU ,VOL ,X ,SURF_NODES,
32 2 N ,NN ,SURF_ELTYP,SURF_ELEM,
33 3 ICONTACT,PORO ,FR_MV, T_MONVOLN)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE monvol_struct_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IVOLU(*), ICONTACT(*), NN, FR_MV(*),
52 . SURF_NODES(NN,4),SURF_ELTYP(NN),SURF_ELEM(NN)
53C REAL
54 my_real
55 . x(3,*), n(3,*),rvolu(*),poro(*),vol
56 TYPE(monvol_struct_), INTENT(IN) :: T_MONVOLN
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,II,K,NOD1,NOD2,NOD3,NOD4
61 my_real AREA,XX,YY,ZZ,X13,Y13,Z13,X24,Y24,Z24,NX, NY, NZ
62 my_real, DIMENSION(:), ALLOCATABLE :: f1, f2
63 DOUBLE PRECISION FRMV6(2,6)
64C--------------------------------------------------------------
65C CALCUL DU VOLUME (variable locale dans MONVOL0)
66C CALCUL DE LA SURFACE (stockee dans RVOLU(18))
67C PORO(*) : PORO=0 aucun noeud en contact
68C PORO=1 tous les noeuds en contact ...
69C--------------------------------------------------------------
70
71 ALLOCATE(f1(nn + t_monvoln%NB_FILL_TRI), f2(nn + t_monvoln%NB_FILL_TRI))
72 IF(intbag==0)THEN
73 DO i=1,nn
74 ii=surf_elem(i)
75 IF(surf_eltyp(i)==7)THEN
76 ii=ii+numelc
77 ELSEIF(surf_eltyp(i)/=3)THEN
78 ii=i+numelc+numeltg
79 ENDIF
80 nod1 = surf_nodes(i,1)
81 nod2 = surf_nodes(i,2)
82 nod3 = surf_nodes(i,3)
83 nod4 = surf_nodes(i,4)
84 xx=half*(x(1,nod1)+x(1,nod2))
85 yy=half*(x(2,nod1)+x(2,nod2))
86 zz=half*(x(3,nod1)+x(3,nod2))
87 x13=x(1,nod3)-x(1,nod1)
88 y13=x(2,nod3)-x(2,nod1)
89 z13=x(3,nod3)-x(3,nod1)
90 x24=x(1,nod4)-x(1,nod2)
91 y24=x(2,nod4)-x(2,nod2)
92 z24=x(3,nod4)-x(3,nod2)
93 n(1,ii)=half*(y13*z24-y24*z13)
94 n(2,ii)=half*(z13*x24-z24*x13)
95 n(3,ii)=half*(x13*y24-x24*y13)
96 f1(i) = sqrt( n(1,ii)**2+n(2,ii)**2+n(3,ii)**2 )
97 f2(i) = third*( n(1,ii)*xx+n(2,ii)*yy+n(3,ii)*zz )
98 ENDDO
99 ELSE
100 DO i=1,nn
101 ii=surf_elem(i)
102 nod1 = surf_nodes(i,1)
103 nod2 = surf_nodes(i,2)
104 nod3 = surf_nodes(i,3)
105 nod4 = surf_nodes(i,4)
106 IF(surf_eltyp(i)==3)THEN
107 poro(ii)=zero
108 IF(icontact(nod1)/=0)poro(ii)=poro(ii)+fourth
109 IF(icontact(nod2)/=0)poro(ii)=poro(ii)+fourth
110 IF(icontact(nod3)/=0)poro(ii)=poro(ii)+fourth
111 IF(icontact(nod4)/=0)poro(ii)=poro(ii)+fourth
112 ELSEIF(surf_eltyp(i)==7)THEN
113 ii=ii+numelc
114 poro(ii)=zero
115 IF(icontact(nod1)/=0)poro(ii)=poro(ii)+third
116 IF(icontact(nod2)/=0)poro(ii)=poro(ii)+third
117 IF(icontact(nod3)/=0)poro(ii)=poro(ii)+third
118 ELSE
119 ii=i+numelc+numeltg
120 poro(ii)=zero
121 IF(icontact(nod1)/=0)poro(ii)=poro(ii)+fourth
122 IF(icontact(nod2)/=0)poro(ii)=poro(ii)+fourth
123 IF(icontact(nod3)/=0)poro(ii)=poro(ii)+fourth
124 IF(icontact(nod4)/=0)poro(ii)=poro(ii)+fourth
125 ENDIF
126 xx=half*(x(1,nod1)+x(1,nod2))
127 yy=half*(x(2,nod1)+x(2,nod2))
128 zz=half*(x(3,nod1)+x(3,nod2))
129 x13=x(1,nod3)-x(1,nod1)
130 y13=x(2,nod3)-x(2,nod1)
131 z13=x(3,nod3)-x(3,nod1)
132 x24=x(1,nod4)-x(1,nod2)
133 y24=x(2,nod4)-x(2,nod2)
134 z24=x(3,nod4)-x(3,nod2)
135 n(1,ii)=half*(y13*z24-y24*z13)
136 n(2,ii)=half*(z13*x24-z24*x13)
137 n(3,ii)=half*(x13*y24-x24*y13)
138 f1(i) = sqrt( n(1,ii)**2+n(2,ii)**2+n(3,ii)**2 )
139 f2(i) = third*( n(1,ii)*xx+n(2,ii)*yy+n(3,ii)*zz )
140 ENDDO
141 ENDIF
142 IF (ispmd + 1 == fr_mv(nspmd + 2)) THEN
143 DO ii = 1, t_monvoln%NB_FILL_TRI
144 nod1 = t_monvoln%FILL_TRI(3 * (ii - 1) + 1)
145 nod2 = t_monvoln%FILL_TRI(3 * (ii - 1) + 2)
146 nod3 = t_monvoln%FILL_TRI(3 * (ii - 1) + 3)
147 nod4 = nod3
148 xx=half*(x(1,nod1)+x(1,nod2))
149 yy=half*(x(2,nod1)+x(2,nod2))
150 zz=half*(x(3,nod1)+x(3,nod2))
151 x13=x(1,nod3)-x(1,nod1)
152 y13=x(2,nod3)-x(2,nod1)
153 z13=x(3,nod3)-x(3,nod1)
154 x24=x(1,nod4)-x(1,nod2)
155 y24=x(2,nod4)-x(2,nod2)
156 z24=x(3,nod4)-x(3,nod2)
157 nx=half*(y13*z24-y24*z13)
158 ny=half*(z13*x24-z24*x13)
159 nz=half*(x13*y24-x24*y13)
160 f1(nn + ii) = sqrt( nx**2+ny**2+nz**2 )
161 f2(nn + ii) = third*( nx*xx+ny*yy+nz*zz )
162 ENDDO
163 ELSE
164 DO ii = 1, t_monvoln%NB_FILL_TRI
165 f1(nn + ii) = zero
166 f2(nn + ii) = zero
167 ENDDO
168 ENDIF
169 DO k = 1, 6
170 frmv6(1,k) = zero
171 frmv6(2,k) = zero
172 END DO
173 CALL sum_6_float(1, nn + t_monvoln%NB_FILL_TRI, f1, frmv6(1,1), 2)
174 CALL sum_6_float(1, nn + t_monvoln%NB_FILL_TRI, f2, frmv6(2,1), 2)
175C comm si necessaire
176 IF(nspmd > 1) THEN
177 CALL spmd_exch_fr6(fr_mv,frmv6,2*6)
178 ENDIF
179C
180 area = frmv6(1,1)+frmv6(1,2)+frmv6(1,3)+
181 . frmv6(1,4)+frmv6(1,5)+frmv6(1,6)
182 vol = frmv6(2,1)+frmv6(2,2)+frmv6(2,3)+
183 . frmv6(2,4)+frmv6(2,5)+frmv6(2,6)
184C
185 rvolu(18) = area
186C
187 RETURN
188 END
my_real
#define my_real
Definition cppsort.cpp:32
monvol_struct_mod
Definition monvol_struct_mod.F:66
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
poro
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)
Definition poro.F:40
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
volum0
subroutine volum0(ivolu, rvolu, vol, x, surf_nodes, n, nn, surf_eltyp, surf_elem, icontact, poro, fr_mv, t_monvoln)
Definition volum0.F:34