OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thcluster.F File Reference

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 38 of file thcluster.F.

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