OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
getphase.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!|| getphase ../starter/source/initial_conditions/inivol/getphase.F
25!||--- called by ------------------------------------------------------
26!|| init_inivol ../starter/source/initial_conditions/inivol/init_inivol.F90
27!||--- calls -----------------------------------------------------
28!|| mean_node_norm2 ../starter/source/initial_conditions/inivol/mean_node_norm2.F
29!|| nfacette ../starter/source/initial_conditions/inivol/nfacette.F
30!|| phase_detection ../starter/source/initial_conditions/inivol/phase_detection.F
31!||====================================================================
32 SUBROUTINE getphase(MVSIZ ,NUMELS ,NUMELTG ,NUMELQ ,NUMNOD ,
33 . NPARG ,NGROUP ,NSURF ,N2D ,
34 . X ,SURF_TYPE ,ITAGNSOL ,DIS ,NSOLTOSF ,
35 . SURF_ELTYP ,KNOD2SURF ,NNOD2SURF ,INOD2SURF ,TAGN ,
36 . IDSURF ,NSEG ,BUFSF ,NOD_NORMAL ,SURF_NODES,
37 . IAD_BUFR ,IDC ,NBCONTY ,NSEG_SWIFT_SURF,SWIFTSURF ,
38 . SEGTOSURF ,IVOLSURF ,NSURF_INVOL,NSEG_USED ,
39 . LEADING_DIMENSION,NB_CELL_X ,NB_CELL_Y ,NB_CELL_Z ,
40 . IPARG ,IXS ,IXQ ,IXTG ,
41 . CELL ,CELL_POSITION,NODAL_PHASE,NB_BOX_LIMIT)
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER,INTENT(IN) :: MVSIZ,NUMELS,NUMELTG,NUMELQ,NUMNOD,NPARG,NGROUP,NSURF,N2D
50 INTEGER IDC,NBCONTY,ITAGNSOL(*),NSOLTOSF(NBCONTY,*),KNOD2SURF(*),NNOD2SURF,TAGN(*),IDSURF,NSEG,
51 . INOD2SURF(NNOD2SURF,*),SURF_TYPE,SURF_ELTYP(NSEG),
52 . SURF_NODES(NSEG,4),IAD_BUFR,SWIFTSURF(NSURF),NSEG_SWIFT_SURF,
53 . SEGTOSURF(*),IVOLSURF(NSURF),NSURF_INVOL
54 my_real X(3,NUMNOD),DIS(NSURF_INVOL,*),BUFSF(*),NOD_NORMAL(3,NUMNOD)
55 INTEGER, INTENT(IN) :: NSEG_USED
56 INTEGER, INTENT(IN) :: LEADING_DIMENSION
57 INTEGER, INTENT(IN) :: NB_BOX_LIMIT
58 INTEGER, INTENT(IN) :: NB_CELL_X,NB_CELL_Y,NB_CELL_Z
59 INTEGER, DIMENSION(NPARG,NGROUP), INTENT(IN) :: IPARG ! group data
60 INTEGER, DIMENSION(NIXS,NUMELS),INTENT(IN), TARGET :: IXS ! solid data
61 INTEGER, DIMENSION(NIXQ,NUMELQ),INTENT(IN), TARGET :: IXQ ! quad data
62 INTEGER, DIMENSION(NIXTG,NUMELTG),INTENT(IN), TARGET :: IXTG ! triangle data
63 INTEGER, DIMENSION(NUMNOD), INTENT(INOUT) :: NODAL_PHASE ! phase of nodes (in / out / near the surface)
64 INTEGER, DIMENSION(3,NUMNOD), INTENT(IN) :: CELL_POSITION ! position of node/cell
65 INTEGER, DIMENSION(NB_CELL_X,NB_CELL_Y,NB_CELL_Z), INTENT(INOUT) :: CELL ! phase of the voxcell
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,J,K,N,INOD,OK,OK1,OK2,FIRST,LAST
70 INTEGER IPL,IXPL1,IXPL2,IXPL3,IXPL4,OK3,IAD0,IN(4),ITYP,JJ
71 INTEGER IPASSN(NUMNOD),p,r,p1,p2,dd1(4),dd2(4)
72 INTEGER NULL_DIST,IX2,SIZE_X2
73
74 my_real nx,ny,nz,xfas(3,4),dist,dist_old,x0,y0,z0,dot,nsign(3),
75 . sum,xp1,yp1,zp1,xp2,yp2,zp2,aa,bb,cc,
76 . dist_pl(3),vx_nod_inod,vy_nod_inod,vz_nod_inod,xsign(3),
77 . v1x,v1y,v1z,v2x,v2y,v2z,v3x,v3y,v3z,v12x,v12y,v12z,xn(3),
78 . tmp(3),skw(9),xg,yg,zg,dgr,x_prime,y_prime,z_prime
79 DATA dd1/4,1,2,3/,dd2/2,3,4,1/
80 INTEGER , DIMENSION(:), ALLOCATABLE :: ID_X2_TAGN,CLOSEST_NODE_ID
81C-----------------------------------------------
82 IF(surf_type == 200) GOTO 950 ! case of infinite plane
83 IF(surf_type == 101) GOTO 951 ! case of ellipsoid
84C
85 ix2 = 0
86 ALLOCATE( id_x2_tagn(numnod) )
87 id_x2_tagn = 0
88!
89! SWIFTSURF ---> tag for each container surface, continuously the total nb of
90! segments. This is used by "SEGTOSURF" to identify for each counted
91! surface segment whom surface belongs
92!
93 swiftsurf(idsurf) = nseg_swift_surf
94!
95 ipassn(1:numnod) = 0
96 first = 1
97 last = min(nseg,mvsiz)
98
99 DO
100
101 DO j=first,last
102 ityp = surf_eltyp(j)
103 in(1) = surf_nodes(j,1)
104 in(2) = surf_nodes(j,2)
105 in(3) = surf_nodes(j,3)
106 in(4) = surf_nodes(j,4)
107
108 xfas(1,1) = x(1,in(1))
109 xfas(2,1) = x(2,in(1))
110 xfas(3,1) = x(3,in(1))
111 xfas(1,2) = x(1,in(2))
112 xfas(2,2) = x(2,in(2))
113 xfas(3,2) = x(3,in(2))
114 xfas(1,3) = x(1,in(3))
115 xfas(2,3) = x(2,in(3))
116 xfas(3,3) = x(3,in(3))
117 xfas(1,4) = x(1,in(4))
118 xfas(2,4) = x(2,in(4))
119 xfas(3,4) = x(3,in(4))
120
121 CALL nfacette(xfas,nx,ny,nz)
122
123 ! fill cutting surfaces from shell elements
124 IF (tagn(in(1)) == 0) THEN
125 tagn(in(1)) = 1
126 ix2 = ix2 + 1
127 id_x2_tagn(ix2) = in(1)
128 ENDIF
129 IF (tagn(in(2)) == 0) THEN
130 tagn(in(2)) = 1
131 ix2 = ix2 + 1
132 id_x2_tagn(ix2) = in(2)
133 ENDIF
134 IF (tagn(in(3)) == 0) THEN
135 tagn(in(3)) = 1
136 ix2 = ix2 + 1
137 id_x2_tagn(ix2) = in(3)
138 ENDIF
139 IF(tagn(in(4)) == 0)THEN
140 tagn(in(4)) = 1
141 ix2 = ix2 + 1
142 id_x2_tagn(ix2) = in(4)
143 ENDIF
144
145 ! fill normals to cut surfaces
146 IF (ityp == 3) THEN
147 DO k=1,4
148 n = in(k)
149 knod2surf(n) = knod2surf(n) + 1
150 inod2surf(knod2surf(n),n) = j + nseg_swift_surf
151 segtosurf(j + nseg_swift_surf) = idsurf
152 ENDDO
153 ELSEIF (ityp == 7) THEN
154 DO k=1,3
155 n = in(k)
156 knod2surf(n) = knod2surf(n) + 1
157 inod2surf(knod2surf(n),n) = j + nseg_swift_surf
158 segtosurf(j + nseg_swift_surf) = idsurf
159 ENDDO
160 ENDIF ! IF(ityp == 3)
161
162 CALL mean_node_norm2(in,nod_normal,nx,ny,nz)
163
164 ENDDO ! next J
165
166 IF(last >= nseg)EXIT
167 first = last + 1
168 last = min(last+mvsiz,nseg)
169
170 ENDDO
171
172
173 nseg_swift_surf = nseg_swift_surf + nseg
174C------------------------------------
175C mean normmal to nodes
176C------------------------------------
177 DO n=1,numnod
178 IF (tagn(n) == 1 .AND. ipassn(n) == 0) THEN
179 aa=one/max(em30,sqrt(nod_normal(1,n)*nod_normal(1,n)+nod_normal(2,n)*nod_normal(2,n)+nod_normal(3,n)*nod_normal(3,n)))
180 nod_normal(1,n)=nod_normal(1,n)*aa
181 nod_normal(2,n)=nod_normal(2,n)*aa
182 nod_normal(3,n)=nod_normal(3,n)*aa
183 ipassn(n) = 1
184 ENDIF
185 ENDDO ! DO N=1,NUMNOD
186
187 ! -------------------------------
188 ! find the phase of the elements : based on the distance of each node to the surface
189 ! to avoid to many computation, the space is divided in cells
190 ! the phase of each cell without any nodes of the surface is found
191 ! then the cell's phase is applied to the nodes belonging to the cell
192 size_x2 = ix2
193 ALLOCATE( closest_node_id(numnod) )
194 closest_node_id(1:numnod) = -1
195 CALL phase_detection(nparg,ngroup,numels,numelq,numeltg,numnod,nsurf,n2d,
196 . leading_dimension,nb_cell_x,nb_cell_y,nb_cell_z,nb_box_limit,
197 . iparg,ixs,ixq,ixtg,x,idsurf,
198 . cell,cell_position,nodal_phase,closest_node_id,
199 . nnod2surf,knod2surf,inod2surf,
200 . nod_normal,nseg_used,segtosurf,nseg,surf_eltyp,surf_nodes,swiftsurf)
201 ! -------------------------------
202 ! save the phase & the closest node of the surface are saved in DIS & NSOLTOSF arrays
203 DO n=1,numnod
204 dist = zero
205 IF(tagn(n) == 0) THEN
206 dist = nodal_phase(n)
207 nsoltosf(idc,n) = closest_node_id(n)
208 ENDIF
209 dis(ivolsurf(idsurf),n) = dist
210 ENDDO
211 DEALLOCATE( closest_node_id )
212 ! -------------------------------
213
214C---
215
216 950 CONTINUE
217C---
218 IF(surf_type /= 200) GOTO 951
219C---
220 iad0 = iad_bufr
221 xp1 = bufsf(iad0+1)
222 yp1 = bufsf(iad0+2)
223 zp1 = bufsf(iad0+3)
224 xp2 = bufsf(iad0+4)
225 yp2 = bufsf(iad0+5)
226 zp2 = bufsf(iad0+6)
227 aa = xp2 - xp1
228 bb = yp2 - yp1
229 cc = zp2 - zp1
230 DO n=1,numnod
231 IF (itagnsol(n) /= 1) cycle
232 dist = zero
233 dist = aa*(x(1,n)-xp1)+bb*(x(2,n)-yp1)+cc*(x(3,n)-zp1)
234 sum = sqrt(aa*aa+bb*bb+cc*cc)
235 sum = one/max(em30,sum)
236 dist = dist*sum
237 dis(ivolsurf(idsurf),n) = dist
238 ENDDO
239C---
240C---
241 951 CONTINUE
242C---
243 IF(surf_type /= 101) GOTO 960
244C---
245 iad0 = iad_bufr
246 aa = bufsf(iad0+1)
247 bb = bufsf(iad0+2)
248 cc = bufsf(iad0+3)
249 xg = bufsf(iad0+4)
250 yg = bufsf(iad0+5)
251 zg = bufsf(iad0+6)
252 skw(1)=bufsf(iad0+7)
253 skw(2)=bufsf(iad0+8)
254 skw(3)=bufsf(iad0+9)
255 skw(4)=bufsf(iad0+10)
256 skw(5)=bufsf(iad0+11)
257 skw(6)=bufsf(iad0+12)
258 skw(7)=bufsf(iad0+13)
259 skw(8)=bufsf(iad0+14)
260 skw(9)=bufsf(iad0+15)
261 dgr=bufsf(iad0+36)
262 DO n=1,numnod
263 IF (itagnsol(n) /= 1) cycle
264 dist=zero
265 !transition matrix
266 x_prime = skw(1)*(x(1,n)-xg) + skw(4)*(x(2,n)-yg) + skw(7)*(x(3,n)-zg)
267 y_prime = skw(2)*(x(1,n)-xg) + skw(5)*(x(2,n)-yg) + skw(8)*(x(3,n)-zg)
268 z_prime = skw(3)*(x(1,n)-xg) + skw(6)*(x(2,n)-yg) + skw(9)*(x(3,n)-zg)
269 tmp(1)= abs(x_prime)/aa
270 tmp(2)= abs(y_prime)/bb
271 tmp(3)= abs(z_prime)/cc
272 IF(tmp(1)/=zero)tmp(1)= exp(dgr*log(tmp(1)))
273 IF(tmp(2)/=zero)tmp(2)= exp(dgr*log(tmp(2)))
274 IF(tmp(3)/=zero)tmp(3)= exp(dgr*log(tmp(3)))
275 dist = (tmp(1)+tmp(2)+tmp(3))
276 dis(ivolsurf(idsurf),n) = one-dist
277 ENDDO
278C---
279 960 CONTINUE
280C---
281 IF (ALLOCATED (id_x2_tagn) ) DEALLOCATE (id_x2_tagn)
282C-----------------------------------------------
283 RETURN
284 END
getphase
subroutine getphase(mvsiz, numels, numeltg, numelq, numnod, nparg, ngroup, nsurf, n2d, x, surf_type, itagnsol, dis, nsoltosf, surf_eltyp, knod2surf, nnod2surf, inod2surf, tagn, idsurf, nseg, bufsf, nod_normal, surf_nodes, iad_bufr, idc, nbconty, nseg_swift_surf, swiftsurf, segtosurf, ivolsurf, nsurf_invol, nseg_used, leading_dimension, nb_cell_x, nb_cell_y, nb_cell_z, iparg, ixs, ixq, ixtg, cell, cell_position, nodal_phase, nb_box_limit)
Definition getphase.F:42
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mean_node_norm2
subroutine mean_node_norm2(in, nod_normal, nx, ny, nz)
Definition mean_node_norm2.F:29
nfacette
subroutine nfacette(xfas, nx, ny, nz)
Definition nfacette.F:30
phase_detection
subroutine phase_detection(nparg, ngroup, numels, numelq, numeltg, numnod, nsurf, n2d, leading_dimension, nb_cell_x, nb_cell_y, nb_cell_z, nb_box_limit, iparg, ixs, ixq, ixtg, x, id_surface, cell, cell_position, nodal_phase, closest_node_id, nnod2surf, knod2surf, inod2surf, nod_normal, nseg_used, segtosurf, nseg, surf_eltyp, surface_nodes, swiftsurf)
Definition phase_detection.F:39