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