OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_idglob.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!||====================================================================
25!|| c_idglob ../starter/source/restart/ddsplit/c_idglob.F
26!||--- called by ------------------------------------------------------
27!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
28!||--- uses -----------------------------------------------------
29!|| reorder_mod ../starter/share/modules1/reorder_mod.F
30!||====================================================================
31 SUBROUTINE c_idglob(NUMEL, NUMELS_L, NUMELQ_L, NUMELTG_L, NUMELS_G, NUMELQ_G, NUMELTG_G,
32 . PROC, CEL, CEP, IPARG, ALE_CONNECTIVITY, IXS,IXQ,IXTG, IDGLOB_L, UIDGLOB_L, N2D, NGROUP, NPARG)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE reorder_mod
38 use element_mod , only : nixs,nixq,nixtg
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER, INTENT(IN) :: N2D !< 2d / 3d flag
47 INTEGER, INTENT(IN) :: NGROUP, NPARG !< sizes of array IPARG
48 INTEGER, INTENT(IN) :: PROC, NUMEL
49 INTEGER, INTENT(IN) :: NUMELS_L, NUMELQ_L, NUMELTG_L !< local number of elems (current domain)
50 INTEGER, INTENT(IN) :: NUMELS_G, NUMELQ_G, NUMELTG_G !< global number of elems (all domains)
51 INTEGER, INTENT(IN) :: CEL(*), CEP(*)
52 INTEGER, INTENT(IN) :: IXS(NIXS, NUMELS_G), IXQ(NIXQ, NUMELQ_G), IXTG(NIXTG, NUMELTG_G)
53 INTEGER, INTENT(IN) :: IPARG(NPARG, NGROUP)
54 INTEGER, INTENT(INOUT) :: IDGLOB_L(*), UIDGLOB_L(*)
55 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER :: PROCI, II, JJ, I, J, I_LOC, NEL, ITY, NFT, ICOUNT,NG, PROCJ, IAD1, LGTH
60 INTEGER :: NELEM_L
61 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG
62C-----------------------------------------------
63C S o u r c e L i n e s
64C-----------------------------------------------
65 ALLOCATE(tag(numel))
66 tag(1:numel) = 0
67
68 icount = 0
69 nelem_l = 0
70 DO ng = 1, ngroup
71 nel = iparg(2, ng)
72 nft = iparg(3, ng)
73 ity = iparg(5, ng)
74 IF (ity == 1) THEN
75 ! bricks
76 nelem_l = numels_l
77 DO ii = 1, nel
78 i = ii + nft
79 iad1 = ale_connectivity%ee_connect%iad_connect(i)
80 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
81 proci = cep(i)
82 IF (proci == proc) THEN
83 i_loc = cel(i)
84 idglob_l(i_loc) = permutation%SOLID(i)
85 uidglob_l(i_loc) = ixs(nixs, i)
86 DO jj = 1, lgth
87 j = ale_connectivity%ee_connect%connected(iad1 + jj - 1)
88 IF (j > 0) THEN
89 procj = cep(j)
90 IF (procj /= proc .AND. tag(j) == 0) THEN
91 icount = icount + 1
92 idglob_l(nelem_l + icount) = permutation%SOLID(j)
93 uidglob_l(nelem_l + icount) = ixs(nixs, j)
94 tag(j) = 1
95 ENDIF
96 ENDIF
97 ENDDO
98 ENDIF
99 ENDDO
100
101 ELSEIF( ity == 2)THEN
102 ! quads
103 nelem_l = numelq_l
104 DO ii = 1, nel
105 i = ii + nft
106 iad1 = ale_connectivity%ee_connect%iad_connect(i)
107 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
108 proci = cep(i)
109 IF (proci == proc) THEN
110 i_loc = cel(i)
111 idglob_l(i_loc) = permutation%SOLID(i)
112 uidglob_l(i_loc) = ixq(nixq, i)
113 DO jj = 1, lgth
114 j = ale_connectivity%ee_connect%connected(iad1 + jj - 1)
115 IF (j > 0) THEN
116 procj = cep(j)
117 IF (procj /= proc .AND. tag(j) == 0) THEN
118 icount = icount + 1
119 idglob_l(nelem_l + icount) = permutation%SOLID(j)
120 uidglob_l(nelem_l + icount) = ixq(nixq, j)
121 tag(j) = 1
122 ENDIF
123 ENDIF
124 ENDDO
125 ENDIF
126 ENDDO
127
128 ELSEIF(ity == 7 .AND. n2d >= 0)THEN
129 ! trias
130 nelem_l = numeltg_l
131 DO ii = 1, nel
132 i = ii + nft
133 iad1 = ale_connectivity%ee_connect%iad_connect(i)
134 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
135 proci = cep(i)
136 IF (proci == proc) THEN
137 i_loc = cel(i)
138 idglob_l(i_loc) = permutation%SOLID(i)
139 uidglob_l(i_loc) = ixtg(nixtg, i)
140 DO jj = 1, lgth
141 j = ale_connectivity%ee_connect%connected(iad1 + jj - 1)
142 IF (j > 0) THEN
143 procj = cep(j)
144 IF (procj /= proc .AND. tag(j) == 0) THEN
145 icount = icount + 1
146 idglob_l(nelem_l + icount) = permutation%SOLID(j)
147 uidglob_l(nelem_l + icount) = ixtg(nixtg , j)
148 tag(j) = 1
149 ENDIF
150 ENDIF
151 ENDDO
152 ENDIF
153 ENDDO
154 ELSE
155 ! not a group of solid elems
156 cycle
157 ENDIF
158
159 ENDDO
160
161 DEALLOCATE(tag)
162 END SUBROUTINE c_idglob
163C
164!||====================================================================
165!|| c_fasolfr ../starter/source/restart/ddsplit/c_idglob.F
166!||--- called by ------------------------------------------------------
167!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
168!||====================================================================
169 SUBROUTINE c_fasolfr(FASOLFR, CEP, P, CEL, NFASOLFR_L)
170C-----------------------------------------------
171C I m p l i c i t T y p e s
172C-----------------------------------------------
173#include "implicit_f.inc"
174C-----------------------------------------------
175C C o m m o n B l o c k s
176C-----------------------------------------------
177#include "com01_c.inc"
178C-----------------------------------------------
179C D u m m y A r g u m e n t s
180C-----------------------------------------------
181 INTEGER FASOLFR(2,*), CEP(*),CEL(*),P, NFASOLFR_L
182C-----------------------------------------------
183C L o c a l V a r i a b l e s
184C-----------------------------------------------
185 INTEGER N, NN
186C
187 DO n=1,nfasolfr
188 nn=fasolfr(1,n)
189 IF(cep(nn)==p)nfasolfr_l=nfasolfr_l+1
190 ENDDO
191C
192 RETURN
193 END
subroutine c_fasolfr(fasolfr, cep, p, cel, nfasolfr_l)
Definition c_idglob.F:170
subroutine c_idglob(numel, numels_l, numelq_l, numeltg_l, numels_g, numelq_g, numeltg_g, proc, cel, cep, iparg, ale_connectivity, ixs, ixq, ixtg, idglob_l, uidglob_l, n2d, ngroup, nparg)
Definition c_idglob.F:33
type(reorder_struct_) permutation
Definition reorder_mod.F:54