OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sort_mid_pid.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!|| sort_mid_pid ../engine/source/system/sort_mid_pid.F
25!||--- called by ------------------------------------------------------
26!|| grpsplit ../engine/source/engine/resol_init.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| mid_pid_mod ../engine/share/modules/mid_pid_mod.F
30!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
31!||====================================================================
32 SUBROUTINE sort_mid_pid(N_SHELL,IGROUC_SHELL,
33 1 POIN_GROUP_MID_SHELL,POIN_GROUP_PID_SHELL,
34 2 MID_SHELL,TAB_LOC,TAB_SHELL_LOC,TAB_MAT)
35
36 USE mid_pid_mod
37 USE my_alloc_mod
38
39! ----------------------------------------------
40! Sort Shell groups :
41!
42! (m1,p1) , (m1,p3), (m1,p1) , (m2,p1) , (m1,p1) , (m56,p7) ... --> sort by mid in MID_PID_SHELL(MID)%PID1D
43! MID_PID_SHELL(m1)%PID1D ( -p1, -p3, -p1, -p1 ...)
44! MID_PID_SHELL(m2)%PID1D ( -p1, ... )
45! MID_PID_SHELL(m56)%PID1D( -p7 ... )
46!
47! add the index of Group NG for each (mi;pj) pairs
48! MID_PID_SHELL(m1)%GROUP1D( NG4, NG6, NG7 , ...) for m1 mid
49!
50! get the number of same pi PID for each mj MID in TAB_LOC(3)
51! MID_PID_SHELL(m1)%PID1D ( -p1, -p3, -p1, -p1 ...) --> 3 p1 ; -p1 becomes +p1
52!
53! get the total number of different (mi,pj) pairs --> COMPTEUR_MAT_PROP_SHELL
54!
55! MID_SHELL(:) : number of pid per mid EQV to PID_INDEX array
56! PID_INDEX(:) : index of pid per mid
57! COMPTEUR_MAT_PROP_SHELL : number of different (mi,pj) pairs
58!
59! MID_PID_SHELL(MID)%PID1D( : ) --> (mid ; pid) pair
60! MID_PID_SHELL(MID)%GROUP1D --> number of Group for (mid,pid)
61
62C-----------------------------------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER, INTENT(IN) ::N_SHELL
75 INTEGER, DIMENSION(NUMMAT), INTENT(IN) :: MID_SHELL
76 INTEGER, DIMENSION(N_SHELL), INTENT(IN) :: IGROUC_SHELL,POIN_GROUP_MID_SHELL,POIN_GROUP_PID_SHELL
77 INTEGER, DIMENSION(NGROUP,5), INTENT(IN) :: TAB_SHELL_LOC
78 INTEGER, DIMENSION(N_SHELL,3), INTENT(INOUT) :: TAB_LOC
79 my_real, INTENT(IN) :: tab_mat(ngroup)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER ::I,J,II,JJ,NBR_MID_PID_GRP
84 INTEGER :: NG,NGG,NGG_LOC
85 INTEGER :: MARQUEUR,MARQUEUR_2,MARQUEUR_3,COMPTEUR_MAT_PROP_SHELL,COMPTEUR
86 INTEGER :: FIRST,LAST,SHIFT,GR_ID,GR_ID2
87 INTEGER :: MID,MAX_MID
88 INTEGER :: PID,MAX_PID,PID_1,PID_2
89 INTEGER, DIMENSION(:), ALLOCATABLE :: PID_INDEX,INDEX
90 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_MID_SHELL
91 my_real poids_j,poids_j1
92 TYPE(mid_pid_type),DIMENSION(:),ALLOCATABLE :: MID_PID_SHELL
93C-----------------------------------------------
94 ALLOCATE(mid_pid_shell(nummat))
95 ALLOCATE(pid_index(nummat) )
96 CALL my_alloc(poin_mid_shell,n_shell)
97 pid_index(1:nummat) = 0
98
99 compteur = 0
100 DO ngg=1,n_shell
101 ng = igrouc_shell(ngg)
102 mid = poin_group_mid_shell(ngg)
103 pid = poin_group_pid_shell(ngg)
104 IF(.NOT.ALLOCATED(mid_pid_shell(mid)%PID1D)) THEN
105 ALLOCATE( mid_pid_shell(mid)%PID1D( mid_shell(mid) ) )
106 ALLOCATE( mid_pid_shell(mid)%GROUP1D(mid_shell(mid) ) )
107
108 mid_pid_shell(mid)%PID1D( 1:mid_shell(mid) ) = 0
109 mid_pid_shell(mid)%GROUP1D( 1:mid_shell(mid) ) = 0
110
111! MID_PID_SHELL(MID)%PID1D( 1:MID_SHELL(MID) ) = 0
112 ! first group of (mid;pid)
113 pid_index(mid) = pid_index(mid) + 1
114 mid_pid_shell(mid)%PID1D( pid_index(mid) ) = -pid
115 mid_pid_shell(mid)%GROUP1D( pid_index(mid) ) = ngg
116 compteur = compteur + 1
117 poin_mid_shell(compteur) = mid
118 ELSE
119 ! other group of (mid;pid)
120 pid_index(mid) = pid_index(mid) + 1
121 mid_pid_shell(mid)%PID1D( pid_index(mid) ) = -pid
122 mid_pid_shell(mid)%GROUP1D( pid_index(mid) ) = ngg
123 ENDIF
124 ENDDO
125
126
127 max_mid = compteur
128
129! Get the max number of pid per mid
130 max_pid = -1
131 DO i=1,max_mid
132 mid = poin_mid_shell(i)
133 max_pid = max( max_pid,pid_index(mid) )
134 ENDDO
135
136 ALLOCATE( index(max_pid) )
137
138 compteur_mat_prop_shell = 0
139 jj = 0
140 DO ii=1,max_mid
141 mid = poin_mid_shell(ii)
142 DO i=1,pid_index(mid)
143 pid_1 = mid_pid_shell(mid)%PID1D( i )
144 compteur = 0
145 IF(pid_1 < 0 ) THEN
146 compteur = 1
147 mid_pid_shell(mid)%PID1D( i ) = -pid_1
148 index(compteur) = i
149
150 DO j=i+1,pid_index(mid)
151 pid_2 = mid_pid_shell(mid)%PID1D( j )
152 IF(pid_1 == pid_2 ) THEN
153 mid_pid_shell(mid)%PID1D( j ) = -pid_2
154 compteur = compteur + 1
155 index(compteur) = j
156 ENDIF
157 ENDDO
158 ENDIF
159 IF(compteur>0) THEN
160 DO j=1,compteur
161 jj = jj + 1
162 ngg_loc = mid_pid_shell(mid)%GROUP1D( index(j) )
163 tab_loc(jj,1) = ngg_loc
164 tab_loc(jj,2) = tab_shell_loc(ngg_loc,1)
165 tab_loc(jj,3) = compteur
166 ENDDO
167 compteur_mat_prop_shell = compteur_mat_prop_shell + 1
168 ENDIF
169 ENDDO
170 ENDDO
171
172 DEALLOCATE( index )
173 DEALLOCATE( pid_index )
174
175 ! tri poids mat/prop
176
177 i=n_shell
178 marqueur = 0
179 DO WHILE((marqueur==0).and.(i>0))
180 marqueur = 1
181 DO j =1,i-1
182 ii=tab_loc(j,1)
183 mid = tab_shell_loc(ii,3)
184 pid = tab_shell_loc(ii,4)
185 gr_id = tab_shell_loc(ii,2)
186 poids_j = tab_mat(gr_id)
187 jj=tab_loc(j+1,1)
188 mid = tab_shell_loc(jj,3)
189 pid = tab_shell_loc(jj,4)
190 gr_id2 = tab_shell_loc(jj,2)
191
192 poids_j1 = tab_mat(gr_id2)
193 IF(poids_j<poids_j1) then
194 marqueur = tab_loc(j,1)
195 marqueur_2 = tab_loc(j,2)
196 marqueur_3 = tab_loc(j,3)
197 tab_loc(j,1) = tab_loc(j+1,1)
198 tab_loc(j,2) = tab_loc(j+1,2)
199 tab_loc(j,3) = tab_loc(j+1,3)
200 tab_loc(j+1,1) = marqueur
201 tab_loc(j+1,2) = marqueur_2
202 tab_loc(j+1,3) = marqueur_3
203 marqueur = 0
204 ENDIF
205 ENDDO
206 i=i-1
207 ENDDO
208
209 ! tri nbr elem
210 shift = 1
211 DO i =1,compteur_mat_prop_shell
212 j = tab_loc(shift,1)
213 mid = tab_shell_loc(j,3)
214 pid = tab_shell_loc(j,4)
215 nbr_mid_pid_grp = tab_loc(shift,3)
216 first = j
217 last = first + nbr_mid_pid_grp - 1
218 marqueur = 0
219 ii = last-first
220 DO WHILE(marqueur==0.and.ii>0)
221 marqueur = 1
222 do jj = first,ii-1
223 if(tab_loc(jj,2)<tab_loc(jj+1,2)) then
224 marqueur = tab_loc(jj,1)
225 marqueur_2 = tab_loc(jj,2)
226 marqueur_3 = tab_loc(jj,3)
227 tab_loc(jj,1) = tab_loc(jj+1,1)
228 tab_loc(jj,2) = tab_loc(jj+1,2)
229 tab_loc(jj+1,1) = marqueur
230 tab_loc(jj+1,2) = marqueur_2
231 tab_loc(jj+1,3) = marqueur_3
232 marqueur = 0
233 ENDIF
234 ENDDO
235 ii = ii - 1
236 ENDDO
237 shift = shift + nbr_mid_pid_grp
238 ENDDO
239
240 DO i=1,max_mid
241 mid = poin_mid_shell(i)
242 DEALLOCATE( mid_pid_shell(mid)%GROUP1D )
243 DEALLOCATE( mid_pid_shell(mid)%PID1D )
244 ENDDO
245
246 DEALLOCATE(mid_pid_shell)
247 DEALLOCATE(poin_mid_shell)
248 RETURN
249 END SUBROUTINE sort_mid_pid
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mid_pid_mod
Definition mid_pid_mod.F:36
sort_mid_pid
subroutine sort_mid_pid(n_shell, igrouc_shell, poin_group_mid_shell, poin_group_pid_shell, mid_shell, tab_loc, tab_shell_loc, tab_mat)
Definition sort_mid_pid.F:35
mid_pid_mod::mid_pid_type
Definition mid_pid_mod.F:44