OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
phase_propagation.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine phase_propagation (ix, iy, iz, nb_cell_x, nb_cell_y, nb_cell_z, nb_box_limit, cell)

Function/Subroutine Documentation

◆ phase_propagation()

subroutine phase_propagation ( integer, intent(in) ix,
integer, intent(in) iy,
integer, intent(in) iz,
integer, intent(in) nb_cell_x,
integer, intent(in) nb_cell_y,
integer, intent(in) nb_cell_z,
integer, intent(in) nb_box_limit,
integer, dimension(nb_cell_x,nb_cell_y,nb_cell_z), intent(inout) cell )

Definition at line 28 of file phase_propagation.F.

29!$COMMENT
30! PHASE_PROPAGATION description
31! PHASE_PROPAGATION propagates the cell value to neighbour
32!
33! PHASE_PROPAGATION organization :
34! the propagation is done in the 3 directions
35! can be done only if the neighbouring cells are empty
36!$ENDCOMMENT
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER, INTENT(IN) :: IX,IY,IZ ! current cell position
53 INTEGER, INTENT(IN) :: NB_CELL_X,NB_CELL_Y,NB_CELL_Z ! number of cell in x/y/z direction
54 INTEGER, INTENT(IN) :: NB_BOX_LIMIT ! upper limit of cell's number
55 INTEGER, DIMENSION(NB_CELL_X,NB_CELL_Y,NB_CELL_Z), INTENT(INOUT) :: CELL ! phase of the voxcell
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 LOGICAL :: X_PROPAGATION,Y_PROPAGATION,Z_PROPAGATION
60 INTEGER :: I,J,K
61 INTEGER :: II,JJ,KK
62 INTEGER :: NEXT_X,NEXT_Y,NEXT_Z
63 INTEGER :: MY_PHASE
64 INTEGER, DIMENSION(NB_BOX_LIMIT) :: X_LIST,Y_LIST,Z_LIST
65C-----------------------------------------------
66
67 my_phase = cell(ix,iy,iz)
68 next_x = 0
69 next_y = 0
70 next_z = 0
71
72 ! --------------------------
73 ! upward x
74 x_propagation = .true.
75 i = ix + 1
76 IF(i>nb_cell_x) x_propagation = .false.
77 DO WHILE( x_propagation )
78 IF(cell(i,iy,iz)==0) THEN
79 cell(i,iy,iz) = my_phase
80 next_x = next_x + 1
81 x_list(next_x) = i
82 i = i + 1
83 ELSE
84 x_propagation = .false.
85 ENDIF
86 IF(i>nb_cell_x) x_propagation = .false.
87 ENDDO
88 ! --------------------------
89
90 ! --------------------------
91 ! backward x
92 x_propagation = .true.
93 i = ix - 1
94 IF(i<1) x_propagation = .false.
95 DO WHILE( x_propagation )
96 IF(cell(i,iy,iz)==0) THEN
97 cell(i,iy,iz) = my_phase
98 next_x = next_x + 1
99 x_list(next_x) = i
100 i = i - 1
101 ELSE
102 x_propagation = .false.
103 ENDIF
104 IF(i<1) x_propagation = .false.
105 ENDDO
106 ! --------------------------
107
108 ! --------------------------
109 IF(next_x>0) THEN
110
111 ! --------------------------
112 ! upward y and upward / backward z
113 y_propagation = .true.
114 j = iy + 1
115 IF(j>nb_cell_y) y_propagation = .false.
116 DO ii=1,next_x
117 i = x_list(ii)
118 DO WHILE( y_propagation )
119 IF(cell(i,j,iz)==0) THEN
120 cell(i,j,iz) = my_phase
121 next_y = next_y + 1
122 y_list(next_y) = j
123 j = j + 1
124 ELSE
125 y_propagation = .false.
126 ENDIF
127 IF(j>nb_cell_y) y_propagation = .false.
128 ENDDO
129
130 ! --------------------------
131 ! upward z
132 z_propagation = .true.
133 k = iz + 1
134 IF(k>nb_cell_z) z_propagation = .false.
135 DO jj=1,next_y
136 j = y_list(jj)
137 DO WHILE( z_propagation )
138 IF(cell(i,j,k)==0) THEN
139 cell(i,j,k) = my_phase
140 k = k + 1
141 ELSE
142 z_propagation = .false.
143 ENDIF
144 IF(k>nb_cell_z) z_propagation = .false.
145 ENDDO
146 ENDDO
147 ! --------------------------
148
149 ! --------------------------
150 ! backward z
151 z_propagation = .true.
152 k = iz - 1
153 IF(k<1) z_propagation = .false.
154 DO jj=1,next_y
155 j = y_list(jj)
156 DO WHILE( z_propagation )
157 IF(cell(i,j,k)==0) THEN
158 cell(i,j,k) = my_phase
159 k = k - 1
160 ELSE
161 z_propagation = .false.
162 ENDIF
163 IF(k<1) z_propagation = .false.
164 ENDDO
165 ENDDO
166 ! --------------------------
167 ENDDO
168 ! --------------------------
169
170 ! --------------------------
171 ! backward y and upward / backward z
172 next_y = 0
173 y_propagation = .true.
174 j = iy - 1
175 IF(j<1) y_propagation = .false.
176 DO ii=1,next_x
177 i = x_list(ii)
178 DO WHILE( y_propagation )
179 IF(cell(i,j,iz)==0) THEN
180 cell(i,j,iz) = my_phase
181 next_y = next_y + 1
182 y_list(next_y) = j
183 j = j - 1
184 ELSE
185 y_propagation = .false.
186 ENDIF
187 IF(j<1) y_propagation = .false.
188 ENDDO
189
190 ! --------------------------
191 ! upward z
192 z_propagation = .true.
193 k = iz + 1
194 IF(k>nb_cell_z) z_propagation = .false.
195 DO jj=1,next_y
196 j = y_list(jj)
197 DO WHILE( z_propagation )
198 IF(cell(i,j,k)==0) THEN
199 cell(i,j,k) = my_phase
200 k = k + 1
201 ELSE
202 z_propagation = .false.
203 ENDIF
204 IF(k>nb_cell_z) z_propagation = .false.
205 ENDDO
206 ENDDO
207 ! --------------------------
208
209 ! --------------------------
210 ! backward z
211 z_propagation = .true.
212 k = iz - 1
213 IF(k<1) z_propagation = .false.
214 DO jj=1,next_y
215 j = y_list(jj)
216 DO WHILE( z_propagation )
217 IF(cell(i,j,k)==0) THEN
218 cell(i,j,k) = my_phase
219 k = k - 1
220 ELSE
221 z_propagation = .false.
222 ENDIF
223 IF(k<1) z_propagation = .false.
224 ENDDO
225 ENDDO
226 ! --------------------------
227 ENDDO
228 ENDIF
229 ! --------------------------
230
231 RETURN