OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
volum0.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine volum0 (ivolu, rvolu, vol, x, surf_nodes, n, nn, surf_eltyp, surf_elem, icontact, poro, fr_mv, t_monvoln)

Function/Subroutine Documentation

◆ volum0()

subroutine volum0 ( integer, dimension(*) ivolu,
rvolu,
vol,
x,
integer, dimension(nn,4) surf_nodes,
n,
integer nn,
integer, dimension(nn) surf_eltyp,
integer, dimension(nn) surf_elem,
integer, dimension(*) icontact,
poro,
integer, dimension(*) fr_mv,
type(monvol_struct_), intent(in) t_monvoln )

Definition at line 31 of file volum0.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
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