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

Go to the source code of this file.

Functions/Subroutines

subroutine w_cluster (cluster, iparg, nodlocal, ncluster_l, cep, proc, numlocgroup, len_ia, len_am)
subroutine c_cluster (clusters, proc, cep, ncluster_l, clusters_id_l)
subroutine applysort2cluster (clusters, permutations)

Function/Subroutine Documentation

◆ applysort2cluster()

subroutine applysort2cluster ( type (cluster_), dimension(ncluster) clusters,
integer, dimension(*) permutations )

Definition at line 247 of file w_cluster.F.

248C Apply the new numbering (given in permutations) to the elements of clusters
249C-----------------------------------------------
250C M o d u l e s
251C-----------------------------------------------
252 USE cluster_mod
253C-----------------------------------------------
254C I m p l i c i t T y p e s
255C-----------------------------------------------
256#include "implicit_f.inc"
257C-----------------------------------------------
258C C o m m o n B l o c k s
259C-----------------------------------------------
260#include "com04_c.inc"
261C-----------------------------------------------
262C D u m m y A r g u m e n t s
263C-----------------------------------------------
264 INTEGER PERMUTATIONS(*)
265 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
266C-----------------------------------------------
267C L o c a l V a r i a b l e s
268C-----------------------------------------------
269 INTEGER I, J, OFFSET
270C=======================================================================
271
272 DO i = 1, ncluster
273 offset = 0
274 IF (clusters(i)%TYPE /= 1) THEN
275 offset = numels+numelq+numelc+numelt+numelp
276 END IF
277 DO j = 1, clusters(i)%NEL
278 clusters(i)%ELEM(j) = permutations(clusters(i)%ELEM(j))
279 END DO
280 END DO
281 RETURN
cluster_mod
Definition cluster_mod.F:40

◆ c_cluster()

subroutine c_cluster ( type (cluster_), dimension(ncluster) clusters,
integer proc,
integer, dimension(*) cep,
integer ncluster_l,
integer, dimension(ncluster) clusters_id_l )

Definition at line 202 of file w_cluster.F.

203C Count the number of clusters per PROC
204C-----------------------------------------------
205C M o d u l e s
206C-----------------------------------------------
207 USE cluster_mod
208C-----------------------------------------------
209C I m p l i c i t T y p e s
210C-----------------------------------------------
211#include "implicit_f.inc"
212C-----------------------------------------------
213C C o m m o n B l o c k s
214C-----------------------------------------------
215#include "com04_c.inc"
216C-----------------------------------------------
217C D u m m y A r g u m e n t s
218C-----------------------------------------------
219 INTEGER PROC, NCLUSTER_L
220 INTEGER CEP(*), CLUSTERS_ID_L(NCLUSTER)
221 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
222C-----------------------------------------------
223C L o c a l V a r i a b l e s
224C-----------------------------------------------
225 INTEGER I,OFF
226C=======================================================================
227 ncluster_l = 0
228 clusters_id_l(1:ncluster) = 0
229 DO i = 1,ncluster
230 off = 0
231 IF (clusters(i)%TYPE /= 1) THEN
232 off = numels+numelq+numelc+numelt+numelp
233 END IF
234 IF (cep(clusters(i)%ELEM(1)+off) == proc) THEN
235 ncluster_l = ncluster_l + 1
236c Local ID of the Ith global cluster
237 clusters_id_l(i) = ncluster_l
238 END IF
239 END DO
240 RETURN

◆ w_cluster()

subroutine w_cluster ( type (cluster_), dimension(ncluster) cluster,
integer, dimension(nparg,*) iparg,
integer, dimension(*) nodlocal,
integer ncluster_l,
integer, dimension(*) cep,
integer proc,
integer, dimension(ngroup) numlocgroup,
integer len_ia,
integer len_am )

Definition at line 31 of file w_cluster.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE cluster_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "param_c.inc"
46#include "com01_c.inc"
47#include "com04_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER CEP(*),NODLOCAL(*),IPARG(NPARG,*)
52 INTEGER NCLUSTER_L,PROC,LEN_IA,LEN_AM
53 INTEGER :: NUMLOCGROUP(NGROUP)
54 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I,II,J,K,ID,NEL,NG,NELG,NNOD,NFT,ITY,IFAIL
59 INTEGER IL, RL
60 INTEGER ESHIFT(3), ILCLUSTER_MAX, RLCLUSTER_MAX
61 my_real, DIMENSION(:), ALLOCATABLE :: rcltab
62 INTEGER, DIMENSION(:), ALLOCATABLE :: ICLTAB,INDX,ILCLUSTER,RLCLUSTER
63
64C=======================================================================
65 eshift(1) = 0 ! brick cluster
66 eshift(2) = numels+numelq+numelc+numelt+numelp ! spring cluster
67 eshift(3) = numels+numelq+numelc+numelt+numelp ! spring cluster special
68 ALLOCATE(indx(ncluster_l)) ! INDeXes of local clusters
69 ALLOCATE(ilcluster(ncluster_l)) ! Integer Lengths of local CLUSTERs
70 ALLOCATE(rlcluster(ncluster_l)) ! Real Lengths of local CLUSTERs
71 j = 0
72 ilcluster(1:ncluster_l) = 0
73 rlcluster(1:ncluster_l) = 0
74 rlcluster_max = 0
75 ilcluster_max = 0
76
77 DO i = 1, ncluster
78 ity = cluster(i)%TYPE
79 IF ( cep(cluster(i)%ELEM(1) + eshift(ity)) == proc ) THEN
80 j = j + 1
81 nel = cluster(i)%NEL
82 nnod = cluster(i)%NNOD
83 ifail = cluster(i)%IFAIL
84 ilcluster(j) = 8 + 2 * (nel + nnod)
85 rlcluster(j) = 1
86 IF (ifail > 0) rlcluster(j) = rlcluster(j) + 4
87 IF (ifail == 3) rlcluster(j) = rlcluster(j) + 8
88 indx(j) = i
89 IF ( rlcluster_max < rlcluster(j) ) THEN
90 rlcluster_max = rlcluster(j)
91 ENDIF
92 IF ( ilcluster_max < ilcluster(j) ) THEN
93 ilcluster_max = ilcluster(j)
94 ENDIF
95 ENDIF
96 ENDDO
97c-----
98 CALL write_i_c(ilcluster,ncluster_l)
99 len_ia = len_ia + ncluster_l
100 CALL write_i_c(rlcluster,ncluster_l)
101 len_ia = len_ia + ncluster_l
102c-----
103 ALLOCATE (icltab(ilcluster_max)) ! Integer CLuster TABle
104 ALLOCATE (rcltab(rlcluster_max)) ! real cluster table
105 DO i = 1, ncluster_l
106 ii = indx(i) ! global number of the cluster
107
108! ICLTAB(1:ILCLUSTER(I)) = 0
109! RCLTAB(1:RLCLUSTER(I)) = ZERO
110
111 il = 0
112 rl = 0
113 icltab(il+1) = cluster(ii)%ID
114 icltab(il+2) = cluster(ii)%TYPE
115 icltab(il+3) = cluster(ii)%IFAIL
116 icltab(il+4) = cluster(ii)%IGR
117 icltab(il+5) = cluster(ii)%NEL
118 icltab(il+6) = cluster(ii)%NNOD
119 icltab(il+7) = cluster(ii)%SKEW
120 icltab(il+8) = cluster(ii)%OFF
121 il = il + 8
122 rcltab(rl+1) = cluster(ii)%FAIL
123 rl = rl + 1
124 nel = cluster(ii)%NEL
125 nnod = cluster(ii)%NNOD
126c
127 DO j = 1,nel
128 id = cluster(ii)%ELEM(j)
129 k = 0
130 DO ng = 1,ngroup
131 nelg = iparg(2,ng)
132 nft = iparg(3,ng)
133 ity = iparg(5,ng)
134 IF (ity == 1 .AND. cluster(ii)%TYPE == 1) THEN
135 k = id - nft
136 IF (k <= nelg) GOTO 100
137 ELSEIF (ity == 6 .AND. cluster(ii)%TYPE == 2) THEN
138 k = id - nft
139 IF (k <= nelg) GOTO 100
140 ENDIF
141 ENDDO ! NG = 1,NGROUP
142 100 CONTINUE
143 icltab(il + j) = numlocgroup(ng) !element local group number
144 icltab(il + j+nel) = k ! element index in the group
145 ENDDO ! J = 1,NEL
146c
147 il = il + nel*2
148 DO j = 1,nnod
149 icltab(il + j) = nodlocal(cluster(ii)%NOD1(j))
150 icltab(il + j+nnod) = nodlocal(cluster(ii)%NOD2(j))
151 ENDDO
152 il = il + nnod*2
153c------------------------------
154 IF (cluster(ii)%IFAIL > 0) THEN
155 rcltab(rl + 1) = cluster(ii)%FMAX(1)
156 rcltab(rl + 2) = cluster(ii)%FMAX(2)
157 rcltab(rl + 3) = cluster(ii)%MMAX(1)
158 rcltab(rl + 4) = cluster(ii)%MMAX(2)
159 rl = rl + 4
160 ENDIF
161 IF (cluster(ii)%IFAIL == 3) THEN
162 rcltab(rl + 1) = cluster(ii)%AX(1)
163 rcltab(rl + 2) = cluster(ii)%AX(2)
164 rcltab(rl + 3) = cluster(ii)%AX(3)
165 rcltab(rl + 4) = cluster(ii)%AX(4)
166 rcltab(rl + 5) = cluster(ii)%NX(1)
167 rcltab(rl + 6) = cluster(ii)%NX(2)
168 rcltab(rl + 7) = cluster(ii)%NX(3)
169 rcltab(rl + 8) = cluster(ii)%NX(4)
170 rl = rl + 8
171 ENDIF
172! ------------------
173! check if I/R CLTAB is fully initialized
174 IF(il< ilcluster(i)) icltab(il+1:ilcluster(i)) = 0
175 IF(rl<rlcluster(i)) rcltab(rl+1:rlcluster(i)) = zero
176! ------------------
177c-----
178 CALL write_db(rcltab,rlcluster(i))
179 len_am = len_am + rlcluster(i)
180 CALL write_i_c(icltab,ilcluster(i))
181 len_ia = len_ia + ilcluster(i)
182
183c-----
184 ENDDO ! I = 1, NCLUSTER_L
185 DEALLOCATE (indx)
186 DEALLOCATE (ilcluster)
187 DEALLOCATE (rlcluster)
188 DEALLOCATE (rcltab)
189 DEALLOCATE (icltab)
190
191C-----------
192 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
write_db
subroutine write_db(a, n)
Definition write_db.F:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645