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

Go to the source code of this file.

Functions/Subroutines

subroutine thcluster (wa, iad, iadv, nn, nvar, ittyp, ithbuf, cluster, skew, x, ixs, iparg)

Function/Subroutine Documentation

◆ thcluster()

subroutine thcluster ( wa,
integer iad,
integer iadv,
integer nn,
integer nvar,
integer ittyp,
integer, dimension(*) ithbuf,
type (cluster_), dimension(ncluster) cluster,
skew,
x,
integer, dimension(nixs,*) ixs,
integer, dimension(nparg,*) iparg )

Definition at line 39 of file thcluster.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46 USE cluster_mod
47 use element_mod , only : nixs
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "task_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER IAD,IADV, NN, NVAR, ITTYP, ITHBUF(*)
63 INTEGER IXS(NIXS,*),IPARG(NPARG,*)
64 my_real wa(*),skew(lskew,*),x(3,*)
65 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER :: J,L,II,JJ,KK,IVAR,ICLUSTER_L,IWA_L,NNOD,ISKN,
70 . N1,N2,N3,N4,NG,NFT
71 my_real :: xm,ym,zm,norm,sx,sy,sz,tx,ty,tz,fs,fn,mb,mt
72 my_real ,DIMENSION(3) :: vx,vy,vn,x1,floc,mloc
73C=======================================================================
74 floc(1:3) = zero
75 mloc(1:3) = zero
76 ii = -1
77 wa(1:nn*nvar) = zero
78 DO j=iad,iad+nn-1
79 icluster_l = ithbuf(j)
80 ii = ii + 1
81 IF (icluster_l > 0) THEN
82 iwa_l = 0
83 DO l=iadv,iadv+nvar-1
84 ivar = ithbuf(l)
85 iwa_l = iwa_l + 1
86 IF (ivar > 6 .and. ivar < 11) THEN
87 iskn = cluster(icluster_l)%SKEW
88 nnod = cluster(icluster_l)%NNOD
89 IF (iskn > 0) THEN
90 vx(1) = skew(1,iskn)
91 vx(2) = skew(2,iskn)
92 vx(3) = skew(3,iskn)
93 vy(1) = skew(4,iskn)
94 vy(2) = skew(5,iskn)
95 vy(3) = skew(6,iskn)
96 vn(1) = skew(7,iskn)
97 vn(2) = skew(8,iskn)
98 vn(3) = skew(9,iskn)
99c
100 ELSE ! ISKN == 0 => calculate local skew
101 x1(1:3) = zero
102 DO jj = 1,nnod
103 n1 = cluster(icluster_l)%NOD1(jj)
104 x1(1) = x1(1) + x(1,n1)
105 x1(2) = x1(2) + x(2,n1)
106 x1(3) = x1(3) + x(3,n1)
107 ENDDO
108 xm = x1(1) / nnod
109 ym = x1(2) / nnod
110 zm = x1(3) / nnod
111c
112 vn(1) = zero
113 vn(2) = zero
114 vn(3) = zero
115c
116 IF (cluster(icluster_l)%TYPE == 1) THEN ! cohesive 3D elements
117 DO kk = 1,cluster(icluster_l)%NEL
118 ng = cluster(icluster_l)%NG(kk)
119 jj = cluster(icluster_l)%ELEM(kk)
120 nft = iparg(3,ng)
121 n1 = ixs(2,nft+jj)
122 n2 = ixs(3,nft+jj)
123 n3 = ixs(4,nft+jj)
124 n4 = ixs(5,nft+jj)
125 sx = x(1,n3) - x(1,n1)
126 sy = x(2,n3) - x(2,n1)
127 sz = x(3,n3) - x(3,n1)
128 tx = x(1,n4) - x(1,n2)
129 ty = x(2,n4) - x(2,n2)
130 tz = x(3,n4) - x(3,n2)
131 vn(1) = vn(1) + sy*tz - sz*ty
132 vn(2) = vn(2) + sz*tx - sx*tz
133 vn(3) = vn(3) + sx*ty - sy*tx
134 END DO
135c
136 ELSE ! spring cluster
137 n1 = cluster(icluster_l)%NOD1(nnod)
138 n2 = cluster(icluster_l)%NOD1(1)
139 sx = xm - x(1,n1)
140 sy = ym - x(2,n1)
141 sz = zm - x(3,n1)
142 tx = xm - x(1,n2)
143 ty = ym - x(2,n2)
144 tz = zm - x(3,n2)
145 vn(1) = vn(1) + sy*tz - sz*ty
146 vn(2) = vn(2) + sz*tx - sx*tz
147 vn(3) = vn(3) + sx*ty - sy*tx
148 DO kk = 1,nnod-1
149 n1 = cluster(icluster_l)%NOD1(kk)
150 n2 = cluster(icluster_l)%NOD1(kk+1)
151 sx = xm - x(1,n1)
152 sy = ym - x(2,n1)
153 sz = zm - x(3,n1)
154 tx = xm - x(1,n2)
155 ty = ym - x(2,n2)
156 tz = zm - x(3,n2)
157 vn(1) = vn(1) + sy*tz - sz*ty
158 vn(2) = vn(2) + sz*tx - sx*tz
159 vn(3) = vn(3) + sx*ty - sy*tx
160 END DO
161 END IF ! cluster type
162c
163 norm = one / sqrt(vn(1)**2 + vn(2)**2 + vn(3)**2)
164 vn(1) = vn(1)*norm
165 vn(2) = vn(2)*norm
166 vn(3) = vn(3)*norm
167c
168c calculate X and Y directions of the local skew
169c
170 n1 = cluster(icluster_l)%NOD1(1)
171 n2 = cluster(icluster_l)%NOD1(2)
172 vx(1) = x(1,n1) - xm
173 vx(2) = x(2,n1) - ym
174 vx(3) = x(3,n1) - zm
175 vy(1) = vn(2)*vx(3) - vn(3)*vx(2)
176 vy(2) = vn(3)*vx(1) - vn(1)*vx(3)
177 vy(3) = vn(1)*vx(2) - vn(2)*vx(1)
178 norm = one / sqrt(vy(1)**2 + vy(2)**2 + vy(3)**2)
179 vy(1) = vy(1)*norm
180 vy(2) = vy(2)*norm
181 vy(3) = vy(3)*norm
182 vx(1) = vy(2)*vn(3) - vy(3)*vn(2)
183 vx(2) = vy(3)*vn(1) - vy(1)*vn(3)
184 vx(3) = vy(1)*vn(2) - vy(2)*vn(1)
185 norm = one / sqrt(vx(1)**2 + vx(2)**2 + vx(3)**2)
186 vx(1) = vx(1)*norm
187 vx(2) = vx(2)*norm
188 vx(3) = vx(3)*norm
189 ENDIF ! ISKN
190c---------------------------------------------------------
191 floc(1) = cluster(icluster_l)%FOR(1)*vx(1) +
192 . cluster(icluster_l)%FOR(2)*vx(2) +
193 . cluster(icluster_l)%FOR(3)*vx(3)
194 floc(2) = cluster(icluster_l)%FOR(1)*vy(1) +
195 . cluster(icluster_l)%FOR(2)*vy(2) +
196 . cluster(icluster_l)%FOR(3)*vy(3)
197 floc(3) = cluster(icluster_l)%FOR(1)*vn(1) +
198 . cluster(icluster_l)%FOR(2)*vn(2) +
199 . cluster(icluster_l)%FOR(3)*vn(3)
200 mloc(1) = cluster(icluster_l)%MOM(1)*vx(1) +
201 . cluster(icluster_l)%MOM(2)*vx(2) +
202 . cluster(icluster_l)%MOM(3)*vx(3)
203 mloc(2) = cluster(icluster_l)%MOM(1)*vy(1) +
204 . cluster(icluster_l)%MOM(2)*vy(2) +
205 . cluster(icluster_l)%MOM(3)*vy(3)
206 mloc(3) = cluster(icluster_l)%MOM(1)*vn(1) +
207 . cluster(icluster_l)%MOM(2)*vn(2) +
208 . cluster(icluster_l)%MOM(3)*vn(3)
209 ENDIF ! IVAR > 6 .and. IVAR < 11
210c
211 IF (ivar==1) THEN ! Fx
212 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%FOR(1)
213 ELSEIF (ivar==2) THEN ! Fy
214 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%FOR(2)
215 ELSEIF (ivar==3) THEN ! Fz
216 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%FOR(3)
217 ELSEIF (ivar==4) THEN ! Mx
218 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%MOM(1)
219 ELSEIF (ivar==5) THEN ! My
220 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%MOM(2)
221 ELSEIF (ivar==6) THEN ! Mz
222 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%MOM(3)
223 ELSEIF (ivar==7) THEN ! F_shear
224 fs = sqrt(floc(1)*floc(1) + floc(2)*floc(2))
225 wa(iwa_l+(ii)*nvar) = fs
226 ELSEIF (ivar==8) THEN ! F_normal
227 fn = abs(floc(3))
228 wa(iwa_l+(ii)*nvar) = fn
229 ELSEIF (ivar==9) THEN ! M_bend
230 mb = sqrt(mloc(1)*mloc(1) + mloc(2)*mloc(2))
231 wa(iwa_l+(ii)*nvar) = mb
232 ELSEIF (ivar==10) THEN ! M_tors
233 mt = abs(mloc(3))
234 wa(iwa_l+(ii)*nvar) = mt
235 ELSEIF (ivar==11) THEN ! DMG
236 wa(iwa_l+(ii)*nvar) = cluster(icluster_l)%FAIL
237 ENDIF
238 END DO !L=IADV,IADV+NVAR-1
239 ENDIF !IF I OWN THE JTH CLUSTER
240 END DO !J=IAD,IAD+NN-1
241c--------------------------
242 IF (nn*nvar > 0) THEN
243 IF (nspmd > 1) CALL spmd_glob_dsum9(wa,nn*nvar)
244 IF (ispmd == 0) THEN
245 CALL wrtdes(wa,wa,nn*nvar,ittyp,1)
246 ENDIF
247 ENDIF
248c-----------
249 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
cluster_mod
Definition cluster_mod.F:40
nvar
integer function nvar(text)
Definition nvar.F:32
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:379
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45