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