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

Go to the source code of this file.

Functions/Subroutines

subroutine domain_decomposition_pcyl (loads, iframe)

Function/Subroutine Documentation

◆ domain_decomposition_pcyl()

subroutine domain_decomposition_pcyl ( type(loads_), intent(inout) loads,
integer, dimension(liskn,numfram+1), intent(in) iframe )

Definition at line 32 of file domain_decomposition_pcyl.F.

33!$COMMENT
34! DOMAIN_DECOMPOSITION_PCYL description
35! DOMAIN_DECOMPOSITION_PCYL affects a segment to a processor
36!
37! DOMAIN_DECOMPOSITION_PCYL organization :
38! loop over the segments of the surface of the load option to :
39! * find where the nodes are defined (a segment is defined by 3 or 4 nodes)
40! * affect a processor to the segment
41! * save the info per processor for the splitting
42! * force the node of the frame used by the load on the processors
43! where /load nodes are defined
44!$ENDCOMMENT
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE loads_mod
49 USE array_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57! nspmd definition
58#include "com01_c.inc"
59! numnod & numfram definition
60#include "com04_c.inc"
61! liskn definition
62#include "param_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 TYPE(LOADS_),INTENT(INOUT) :: LOADS ! structure of load cyl
67 INTEGER ,DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME ! frame data structure
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 LOGICAL :: NEXT_OPERATION
72 INTEGER :: I,J,K
73 INTEGER :: NUMBER_SEGMENT,LOCAL_NUMBER_SEG,NUMBER_NODE
74 INTEGER :: NODE_ID,MY_PROC,MY_SIZE,FRAME_ID
75 INTEGER :: NUMBER_PROC,NUMBER_PROC_1,NUMBER_PROC_2
76 INTEGER, DIMENSION(NSPMD) :: LIST_1,LIST_2
77 INTEGER :: NB_RESULT_INTERSECT
78 INTEGER, DIMENSION(NSPMD) :: RESULT_INTERSECT
79 INTEGER, DIMENSION(NSPMD) :: PROC_ARRAY
80 LOGICAL, DIMENSION(:), ALLOCATABLE :: BOOL
81 INTEGER, DIMENSION(:), ALLOCATABLE :: TEMP_ARRAY
82 TYPE(array_type_int_1d), DIMENSION(:), ALLOCATABLE :: LOCAL_ARRAY
83 INTEGER :: NB_LOCAL_ARRAY
84 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_LOCAL_ARRAY
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 ALLOCATE( bool(numnod) )
89 bool(1:numnod) = .true.
90 nb_local_array = 0
91 ALLOCATE( index_local_array(numnod) )
92 ALLOCATE( local_array(numnod) )
93 local_array(1:numnod)%SIZE_INT_ARRAY_1D = 0
94
95 IF(.NOT.ALLOCATED(loads%CYL_RESTART)) ALLOCATE( loads%CYL_RESTART(loads%NLOAD_CYL) )
96 ! -------------------
97 ! loop over the /LOAD/PCYL
98 DO i=1,loads%NLOAD_CYL
99 number_segment = loads%LOAD_CYL(i)%NSEG ! number of segment for the PCYL I
100 ! ------------
101 ! loop over the segments of the surface to find where the node id are defined
102 DO j=1,number_segment ! loop over the segments of the surface
103 DO k=1,4
104 node_id = loads%LOAD_CYL(i)%SEGNOD(j,k) ! get the node id (if the segment is a triangle, NODE_ID(node 4) = 0))
105 number_proc = 0
106 IF(node_id/=0) THEN
107 IF(bool(node_id)) THEN
108 CALL plist_ifront(proc_array,node_id,number_proc)
109 bool(node_id) = .false.
110 local_array(node_id)%SIZE_INT_ARRAY_1D = number_proc
111 CALL alloc_1d_array(local_array(node_id))
112 local_array(node_id)%INT_ARRAY_1D(1:number_proc) = proc_array(1:number_proc)
113 nb_local_array = nb_local_array + 1
114 index_local_array(nb_local_array) = node_id
115 ENDIF
116 ENDIF
117 ENDDO
118 ENDDO
119 ! ------------
120
121 ! ------------
122 IF(.NOT.ALLOCATED(loads%CYL_RESTART(i)%SEGMENT_TO_PROC)) THEN
123 ALLOCATE( loads%CYL_RESTART(i)%SEGMENT_TO_PROC(number_segment) )
124 ENDIF
125 IF(.NOT.ALLOCATED(loads%CYL_RESTART(i)%PROC)) ALLOCATE( loads%CYL_RESTART(i)%PROC(nspmd) )
126 DO j=1,nspmd
127 loads%CYL_RESTART(i)%PROC(j)%LOCAL_SEGMENT_NUMBER = 0
128 loads%CYL_RESTART(i)%PROC(j)%S_LOCAL_SEGMENT = number_segment / nspmd + 4
129 my_size = loads%CYL_RESTART(i)%PROC(j)%S_LOCAL_SEGMENT
130 IF(ALLOCATED(loads%CYL_RESTART(i)%PROC(j)%LOCAL_SEGMENT)) THEN
131 DEALLOCATE( loads%CYL_RESTART(i)%PROC(j)%LOCAL_SEGMENT )
132 ENDIF
133 ALLOCATE( loads%CYL_RESTART(i)%PROC(j)%LOCAL_SEGMENT(my_size) )
134 ENDDO
135
136 DO j=1,number_segment
137 number_node = 4
138 node_id = loads%LOAD_CYL(i)%SEGNOD(j,4)
139 IF(node_id==0) number_node = 3
140
141 node_id = loads%LOAD_CYL(i)%SEGNOD(j,1)
142 number_proc_1 = local_array(node_id)%SIZE_INT_ARRAY_1D
143 list_1(1:number_proc_1) = local_array(node_id)%INT_ARRAY_1D(1:number_proc_1)
144 next_operation = .true.
145 ! -----------------------
146 ! find the processors where the nodes are defined
147 ! if the nodes are on 2 or more processors, need to choose the main processor
148 ! (main processor is the processor that will compute the surface in the engine)
149 DO k=2,number_node
150 node_id = loads%LOAD_CYL(i)%SEGNOD(j,k)
151 number_proc_2 = local_array(node_id)%SIZE_INT_ARRAY_1D
152 list_2(1:number_proc_2) = local_array(node_id)%INT_ARRAY_1D(1:number_proc_2)
153 ! -----------------------
154 ! intersection of processor
155 IF(next_operation) THEN
156 CALL intersect_2_sorted_sets( list_1,number_proc_1,
157 . list_2,number_proc_2,
158 . result_intersect,nb_result_intersect )
159 IF(nb_result_intersect>0) THEN
160 list_1(1:nb_result_intersect) = result_intersect(1:nb_result_intersect)
161 number_proc_1 = nb_result_intersect
162 ENDIF
163 ELSE
164 nb_result_intersect = 0
165 ENDIF
166 next_operation = (nb_result_intersect>0)
167 ! end : intersection of surface
168 ! -----------------------
169 ENDDO
170 ! -----------------------
171
172 IF(nb_result_intersect>0) THEN
173 my_proc = list_1(1) ! choose the first processor of the list
174 ELSE
175 my_proc = list_1(1) ! choose the first processor of the list and add the 4 nodes on this processor
176 DO k=1,number_node
177 node_id = loads%LOAD_CYL(i)%SEGNOD(j,k)
178 CALL ifrontplus(node_id,my_proc) ! add the missig node on the processor MY_PROC
179 ENDDO
180 ENDIF
181
182
183 loads%CYL_RESTART(i)%SEGMENT_TO_PROC(j) = my_proc
184 local_number_seg = loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT_NUMBER
185
186
187 my_size = loads%CYL_RESTART(i)%PROC(my_proc)%S_LOCAL_SEGMENT
188 IF(my_size< local_number_seg + 1 ) THEN
189 ALLOCATE(temp_array(local_number_seg))
190 temp_array(1:local_number_seg) =
191 . loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT(1:local_number_seg)
192 DEALLOCATE( loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT )
193 loads%CYL_RESTART(i)%PROC(my_proc)%S_LOCAL_SEGMENT = my_size *1.2 + 4
194 my_size = loads%CYL_RESTART(i)%PROC(my_proc)%S_LOCAL_SEGMENT
195 ALLOCATE( loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT(my_size) )
196 loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT(1:local_number_seg) =
197 . temp_array(1:local_number_seg)
198 DEALLOCATE(temp_array)
199 ENDIF
200 local_number_seg = local_number_seg + 1
201 loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT_NUMBER = local_number_seg
202 loads%CYL_RESTART(i)%PROC(my_proc)%LOCAL_SEGMENT( local_number_seg ) = j
203 ENDDO
204 ! ------------
205
206 ! ------------
207 ! add the node of the frame on the processors with /load nodes
208 DO j=1,nspmd
209 IF(loads%CYL_RESTART(i)%PROC(j)%LOCAL_SEGMENT_NUMBER>0) THEN
210 frame_id = loads%LOAD_CYL(i)%IFRAME + 1
211 IF(frame_id > 0 .and. iframe(5,frame_id) > 0) THEN
212 DO k=1,2
213 node_id = iframe(k,frame_id)
214 CALL ifrontplus(node_id,j)
215 ENDDO
216 ENDIF
217 ENDIF
218 ENDDO
219 ! ------------
220 ENDDO
221 ! -------------------
222
223 ! loop over the nodes used by the /load to deallocate LOCAL_ARRAY%... array
224 DO j=1,nb_local_array
225 node_id = index_local_array(j)
226 CALL dealloc_1d_array(local_array(node_id))
227 ENDDO
228 ! ------------
229
230 DEALLOCATE( bool )
231 DEALLOCATE( local_array )
232 RETURN
plist_ifront
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
array_mod::alloc_1d_array
Definition array_mod.F:95
array_mod::dealloc_1d_array
Definition array_mod.F:99
array_mod
Definition array_mod.F:51