1 /* CalculiX - A 3-dimensional finite element program */
2 /* Copyright (C) 1998-2021 Guido Dhondt */
3
4 /* This program is free software; you can redistribute it and/or */
5 /* modify it under the terms of the GNU General Public License as */
6 /* published by the Free Software Foundation(version 2); */
7 /* */
8
9 /* This program is distributed in the hope that it will be useful, */
10 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
11 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
12 /* GNU General Public License for more details. */
13
14 /* You should have received a copy of the GNU General Public License */
15 /* along with this program; if not, write to the Free Software */
16 /* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
17
18 #include <stdio.h>
19 #include <math.h>
20 #include <stdlib.h>
21 #include <time.h>
22 #include "CalculiX.h"
23 #include "mortar.h"
24
25 #define max(a,b) (((a) > (b)) ? (a) : (b))
26 #define min(a,b) (((a) < (b)) ? (a) : (b))
27 #define abs(a) (((a) < (0)) ? (-a) : (a))
28
29 /** transforming the system back to the standard basis functions
30 \f$ \tilde{u}\rightarrow u \f$ and updating the active
31 * and inactive sets and the Langrange Multipliers (LM)
32 * see Sitzmann Algorithm 2, p.71
33 *
34 * Author: Saskia Sitzmann
35 *
36 * [in] bhat intermediate right hand side
37 * [in] adc intermediate system matrix, diagonal terms
38 * [in] auc intermediate system matrix, nondiagonal terms
39 * [in] jqc pointer to irowc
40 * [in] irowc row numbers of auc
41 * [in] neq number of active degrees of freedom
42 * [in] gap (i) gap for slave node i
43 * [in,out] b in: differenzial displacement out:real displacement
44 * [in,out] islavact (i) indicates, if slave node i is active (=-3 no-slave-node, =-2 no-LM-node, =-1 no-gap-node, =0 inactive node, =1 sticky node, =2 slipping/active node)
45 * [out] irowddinv field containing row numbers of auddinv
46 * [out] jqddinv pointer into field irowddinv
47 * [out] auddinv coupling matrix \f$ \tilde{D}^{-1}_d[nactdof(i,p),nactdof(j,q)]\f$ for all active degrees od freedoms
48 * [in] irowtloc field containing row numbers of autloc
49 * [in] jqtloc pointer into field irowtloc
50 * [in] autloc transformation matrix \f$ T[p,q]\f$ for slave nodes \f$ p,q \f$
51 * [in] irowtlocinv field containing row numbers of autlocinv
52 * [in] jqtlocinv pointer into field irowtlocinv
53 * [in] autlocinv transformation matrix \f$ T^{-1}[p,q]\f$ for slave nodes \f$ p,q \f$
54 * [in] ntie number of contraints
55 * [in] nslavnode (i)pointer into field isalvnode for contact tie i
56 * [in] islavnode field storing the nodes of the slave surface
57 * [in] nmastnode (i)pointer into field imastnode for contact tie i
58 * [in] imastnode field storing the nodes of the master surfaces
59 * [in] slavnor slave normals
60 * [in] slavtan slave tangents
61 * [in] nactdof (i,j) actual degree of freedom for direction i of node j
62 * [out] iflagact flag indicating if semi-smooth Newton has converged
63 * [in,out] cstress current Lagrange multiplier
64 * [in] cstressini Lagrange multiplier at start of the increment
65 * [out] cdisp vector saving contact variables for frd-output
66 * [out] f_cs contact forces for active degrees of freedom
67 * [out] f_cm not used any more
68 * [out] bp current friction bound
69 * [in] nboun2 number of transformed SPCs
70 * [in] ndirboun2 (i) direction of transformed SPC i
71 * [in] nodeboun2 (i) node of transformed SPC i
72 * [in] xboun2 (i) value of transformed SPC i
73 * [in] nmpc2 number of transformed mpcs
74 * [in] ipompc2 (i) pointer to nodempc and coeffmpc for transformed MPC i
75 * [in] nodempc2 nodes and directions of transformed MPCs
76 * [in] coefmpc2 coefficients of transformed MPCs
77 * [in] ikboun2 sorted dofs idof=8*(node-1)+dir for transformed SPCs
78 * [in] ilboun2 transformed SPC numbers for sorted dofs
79 * [in] ikmpc2 sorted dofs idof=8*(node-1)+dir for transformed MPCs
80 * [in] ilmpc2 transformed SPC numbers for sorted dofs
81 * [in] nslavspc2 (2*i) pointer to islavspc2...
82 * [in] islavspc2 ... which stores transformed SPCs for slave node i
83 * [in] nsspc2 number of transformed SPC for slave nodes
84 * [in] nslavmpc2 (2*i) pointer to islavmpc2...
85 * [in] islavmpc2 ... which stores transformed MPCs for slave node i
86 * [in] nsmpc2 number of transformed MPC for slave nodes
87 * [in] nmastspc (2*i) pointer to imastspc...
88 * [in] imastspc ... which stores SPCs for master node i
89 * [in] nmspc number of SPC for master nodes
90 * [in] nmastmpc (2*i) pointer to imastmpc...
91 * [in] imastmpc ... which stores MPCs for master node i
92 * [in] nmmpc number of MPC for master nodes
93 * [out] cfs contact force
94 * [out] cfm not used any more
95 * [in] islavnodeinv (i) slave node index for node i
96 * [out] Bd coupling matrix \f$ B_d[p,q]=\int \psi_p \phi_q dS \f$, \f$ p \in S, q \in M \f$
97 * [out] irowb field containing row numbers of Bd
98 * [out] jqb pointer into field irowb
99 * [out] Dd coupling matrix \f$ D_d[p,q]=\int \psi_p \phi_q dS \f$, \f$ p,q \in S \f$
100 * [out] irowd field containing row numbers of Dd
101 * [out] jqd pointer into field irowd
102 * [out] Ddtil coupling matrix \f$ \tilde{D}_d[p,q]=\int \psi_p \tilde{\phi}_q dS \f$, \f$ p,q \in S \f$
103 * [out] irowdtil field containing row numbers of Ddtil
104 * [out] jqdtil pointer into field irowdtil
105 * [out] Bpgd Petrov-Galerkin coupling matrix \f$ B_d^{PG}[p,q]=\int \tilde{\phi}_p \phi_q dS \f$, \f$ p \in S, q \in M \f$
106 * [out] irowbpg field containing row numbers of Bpgd
107 * [out] jqbpg pointer into field irowbpg
108 * [out] Dpgd Petrov-Galerkin coupling matrix \f$ D_d[p,q]=\int \tilde{\phi}_p \phi_q dS \f$, \f$ p,q \in S \f$
109 * [out] irowdpg field containing row numbers of Dpgd
110 * [out] jqdpg pointer into field irowdpg
111 * [in] lambdaiwan Lagrange multiplier splitted to Iwan elements
112 * [in] lambdaiwanini Lagrange multiplier splitted to Iwan elements at start of increment
113 * [in] nmethod analysis method
114 * [in] iflagdualquad flag indicating what mortar contact is used (=1 quad-lin, =2 quad-quad, =3 PG quad-lin, =4 PG quad-quad)
115 * [in] ithermal thermal method
116 * [in] iperturb geometrical method
117 * [in] labmpc labels of MPCs
118 * [in] labmpc2 labels of transformed MPCs
119 * [in] nk2 number or generated points needed for transformed SPCs
120 */
121
stressmortar(double * bhat,double * adc,double * auc,ITG * jqc,ITG * irowc,ITG * neq,double * gap,double * b,ITG * islavact,ITG * irowddinv,ITG * jqddinv,double * auddinv,ITG * irowtloc,ITG * jqtloc,double * autloc,ITG * irowtlocinv,ITG * jqtlocinv,double * autlocinv,ITG * ntie,ITG * nslavnode,ITG * islavnode,ITG * nmastnode,ITG * imastnode,double * slavnor,double * slavtan,ITG * nactdof,ITG * iflagact,double * cstress,double * cstressini,ITG * mi,double * cdisp,double * f_cs,double * f_cm,ITG * iit,ITG * iinc,double * vold,double * vini,double * bp,ITG * nk,ITG * nboun2,ITG * ndirboun2,ITG * nodeboun2,double * xboun2,ITG * nmpc2,ITG * ipompc2,ITG * nodempc2,double * coefmpc2,ITG * ikboun2,ITG * ilboun2,ITG * ikmpc2,ITG * ilmpc2,ITG * nmpc,ITG * ipompc,ITG * nodempc,double * coefmpc,ITG * ikboun,ITG * ilboun,ITG * ikmpc,ITG * ilmpc,ITG * nslavspc2,ITG * islavspc2,ITG * nsspc2,ITG * nslavmpc2,ITG * islavmpc2,ITG * nsmpc2,ITG * nmastspc,ITG * imastspc,ITG * nmspc,ITG * nmastmpc,ITG * imastmpc,ITG * nmmpc,char * tieset,double * elcon,double * tietol,ITG * ncmat_,ITG * ntmat_,double * plicon,ITG * nplicon,ITG * npmat_,ITG * nelcon,double * dtime,double * cfs,double * cfm,ITG * islavnodeinv,double * Bd,ITG * irowb,ITG * jqb,double * Dd,ITG * irowd,ITG * jqd,double * Ddtil,ITG * irowdtil,ITG * jqdtil,double * Bdtil,ITG * irowbtil,ITG * jqbtil,double * Bpgd,ITG * irowbpg,ITG * jqbpg,double * Dpgd,ITG * irowdpg,ITG * jqdpg,double * lambdaiwan,double * lambdaiwanini,ITG * nmethod,double * bet,ITG * iflagdualquad,ITG * ithermal,ITG * iperturb,char * labmpc,char * labmpc2,double * cam,double * veold,double * accold,double * gam,ITG * nk2,double * cfsini,double * cfstil,double * plkcon,ITG * nplkcon,char * filab,double * f,double * fn,double * qa,ITG * nprint,char * prlab,double * xforc,ITG * nforc)122 void stressmortar(double *bhat,double *adc,double *auc,ITG *jqc,ITG *irowc,
123 ITG *neq,double *gap,double *b,ITG *islavact,
124 ITG *irowddinv,ITG *jqddinv,double *auddinv,ITG *irowtloc,
125 ITG *jqtloc,double *autloc,ITG *irowtlocinv,ITG *jqtlocinv,
126 double *autlocinv,ITG *ntie,ITG *nslavnode,ITG *islavnode,
127 ITG *nmastnode,ITG *imastnode,double *slavnor,
128 double *slavtan,ITG *nactdof,ITG *iflagact,double *cstress,
129 double *cstressini,ITG *mi,double *cdisp,double *f_cs,
130 double *f_cm,ITG *iit,ITG *iinc,double *vold,double *vini,
131 double* bp,ITG *nk,ITG *nboun2,ITG *ndirboun2,
132 ITG *nodeboun2,double *xboun2,ITG *nmpc2,ITG *ipompc2,
133 ITG *nodempc2,double *coefmpc2,ITG *ikboun2,ITG *ilboun2,
134 ITG *ikmpc2,ITG *ilmpc2,ITG *nmpc,ITG *ipompc,ITG *nodempc,
135 double *coefmpc,ITG *ikboun,ITG *ilboun,ITG *ikmpc,
136 ITG *ilmpc,ITG *nslavspc2,ITG *islavspc2,ITG *nsspc2,
137 ITG *nslavmpc2,ITG *islavmpc2,ITG *nsmpc2,ITG *nmastspc,
138 ITG *imastspc,ITG *nmspc,ITG *nmastmpc,ITG *imastmpc,
139 ITG *nmmpc,char *tieset,double *elcon,double *tietol,
140 ITG *ncmat_,ITG *ntmat_,double *plicon,ITG *nplicon,
141 ITG *npmat_,ITG *nelcon,double *dtime,double *cfs,
142 double *cfm,ITG *islavnodeinv,double *Bd,ITG *irowb,
143 ITG *jqb,double *Dd,ITG *irowd,ITG *jqd,double *Ddtil,
144 ITG *irowdtil,ITG *jqdtil,double *Bdtil,ITG *irowbtil,
145 ITG *jqbtil,double *Bpgd,ITG *irowbpg,ITG *jqbpg,
146 double *Dpgd,ITG *irowdpg,ITG *jqdpg,double *lambdaiwan,
147 double *lambdaiwanini,ITG *nmethod,double *bet,
148 ITG *iflagdualquad,ITG *ithermal,ITG *iperturb,
149 char *labmpc,char *labmpc2,double *cam,double *veold,
150 double *accold,double *gam,ITG *nk2,double *cfsini,
151 double *cfstil,double *plkcon,ITG *nplkcon,char *filab,
152 double *f,double *fn,double *qa,ITG *nprint,char *prlab,
153 double *xforc,ITG *nforc){
154
155 ITG i,j,l,jj,k,idof1,idof2,idof3,nodes,mt=mi[1]+1,nstick=0,nslip=0,ninacti=0,
156 nnogap=0,nolm=0,ndiverg,nhelp,debug,idof,node2,dirind,dirdep,index,ist,
157 yielded,iout,num_cpus=1,keepset,derivmode,regmode,node_max_ncf_n,
158 node_max_ncf_t[2],ndof,regmodet,iwan,calcul_fn,calcul_f;
159
160 double aux,stressnormal,ddispnormal,*unitmatrix=NULL,atau2,constant=1.E10,
161 constantn=1.E10,constantt=1.E10,stresst[2],stressinit[2],stresstildet[2],
162 ddispt[2],disp_totalnormal,disp_tildet[2],bpold,nw_t=0.0,*du=NULL,f_csn,
163 f_cmn,ch,coefdep,disp_t[2],disp_tildeto[2],scal,w_t[3],*bhat2=NULL,n[3],
164 t[6],*fmpc=NULL,lm_t1_av,lm_t2_av,*rc=NULL,f_cs_tot[4],f_cm_tot[4],
165 *vectornull=NULL,*u_oldt=NULL,resreg[2],rslip[6],ltslip[6],ltu[2],
166 resreg2[2],*cstress2=NULL,*cstresstil=NULL,*cstressini2=NULL,*u_old=NULL,
167 aninvloc,atauinvloc,gnc,gtc[2],*cold=NULL,*cold2=NULL,disp_t2[2],ln_old,
168 ncf_n,max_ncf_n,ncf_t[2],max_ncf_t[2],mu,mumax,p0,beta,*b2=NULL,alpha;
169
170 debug=0;
171 alpha=1-2*sqrt(*bet);
172 keepset=0;
173 mumax=-1.0;
174 max_ncf_n=-1.0; max_ncf_t[0]=-1.0; max_ncf_t[1]=-1.0;
175 node_max_ncf_n=0;node_max_ncf_t[0]=0;node_max_ncf_t[1]=0;
176 lm_t1_av=0;lm_t2_av=0;
177 *iflagact=0;
178
179 NNEW(vectornull,double,neq[1]);
180 NNEW(cstress2,double,neq[1]);
181 NNEW(bhat2,double,mt*(*nk+*nk2));
182 NNEW(b2,double,mt*(*nk+*nk2));
183 NNEW(cold,double,3*nslavnode[*ntie]);
184 NNEW(cold2,double,3*nslavnode[*ntie]);
185 NNEW(cstresstil,double,mt*nslavnode[*ntie]);
186 NNEW(cstressini2,double,mt*nslavnode[*ntie]);
187 NNEW(du,double,3*nslavnode[*ntie]);
188 NNEW(u_old,double,3*nslavnode[*ntie]);
189 NNEW(u_oldt,double,3*nslavnode[*ntie]);
190 ndiverg=14;
191
192 /* get cstress2 (Sitzmann,Equation (4.14)) */
193
194 FORTRAN(opnonsym,(&neq[1],&aux,b,vectornull,adc,auc,jqc,irowc));
195 for(i=0;i<neq[1];i++){f_cs[i]=bhat[i]-vectornull[i];}
196
197 for(i=0;i<neq[1];i++){vectornull[i]=0.0;}
198 FORTRAN(opnonsymt,(&neq[1],&aux,f_cs,cstress2,vectornull,auddinv,jqddinv,
199 irowddinv));
200 for(i=0;i<neq[1];i++){f_cs[i]=0.0;}
201
202 NNEW(unitmatrix,double,neq[1]);
203
204 // mechanical part
205
206 for(i=0;i<neq[0];i++){
207 unitmatrix[i]=1.;vectornull[i]=0.0;
208 if(*nmethod==4){
209 cstress2[i]*=1.0/(1.0+alpha);
210 }
211 }
212
213 // thermal part
214
215 for(i=neq[0];i<neq[1];i++){
216 unitmatrix[i]=1.;vectornull[i]=0.0;
217 }
218 for(i=0;i<mt**nk;i++){bhat2[i]=0.0;}
219 iout=1;
220
221 /* fill in missing results from SPCs/MPCs */
222
223 FORTRAN(resultsini_mortar,(nk,b2,ithermal,iperturb,nactdof,&iout,vold,b,
224 nodeboun2,ndirboun2,xboun2,nboun2,ipompc2,
225 nodempc2,coefmpc2,labmpc2,nmpc2,nmethod,cam,bet,
226 gam,dtime,mi));
227
228 /* transformation delta tildeu^q->delta u:
229 u=T tildeu^q*/
230
231 for(i=0;i<*nk;i++){
232 nodes=i+1;
233 for(jj=jqtloc[nodes-1]-1;jj<jqtloc[nodes-1+1]-1;jj++){
234 for(l=0;l<3;l++){
235 idof1=mt*nodes-3+l;
236 idof2=mt*irowtloc[jj]-3+l;
237 bhat2[idof2]+=autloc[jj]*b2[idof1];
238 }
239 if(debug==1){
240 printf("node %d b2 %e du %e u %e \n",i,b2[mt*(i+1)-4],bhat2[mt*(i+1)-4],
241 vold[mt*(i+1)-4]);
242 printf("node %d b2 %e du %e u %e \n",i,b2[mt*(i+1)-3],bhat2[mt*(i+1)-3],
243 vold[mt*(i+1)-3]);
244 printf("node %d b2 %e du %e u %e \n",i,b2[mt*(i+1)-2],bhat2[mt*(i+1)-2],
245 vold[mt*(i+1)-2]);
246 printf("node %d b2 %e du %e u %e \n",i,b2[mt*(i+1)-1],bhat2[mt*(i+1)-1],
247 vold[mt*(i+1)-1]);
248 }
249 }
250 }
251
252 /* overwrite b with untransformed delta u*/
253
254 for( i=0; i<*ntie; i++){
255 if(tieset[i*(81*3)+80]=='C'){
256 nhelp=0;
257 for(j=nslavnode[i]; j<nslavnode[i+1]; j++){
258 nodes=islavnode[j];
259 for(l=0;l<3;l++){
260 b2[mt*nodes-3+l]=bhat2[mt*nodes-3+l];
261 idof1=nactdof[mt*nodes-3+l]-1;
262 if(idof1>-1){
263 if(*nmethod==4){
264 b[idof1]=(b2[mt*nodes-3+l])/(*bet**dtime**dtime);
265 }else{
266 b[idof1]=b2[mt*nodes-3+l];
267 }
268 }
269 }
270 if(islavact[j]>-1){nhelp++;}
271 }
272 ndiverg=max(ndiverg,(nhelp/100)+*ntie);
273 }
274 }
275
276 /* calculate hatu=D u^S+ B u^M for update in semi-smooth Newton,
277 see Sitzmann Chapter 3.4. */
278
279 if(*iflagdualquad>2){
280
281 /* Petrov-Galerkin formulation*/
282 /* get du^hat */
283 /* get uhat_k-1 */
284
285 for(i=0;i<*nk;i++){
286 nodes=i+1;
287 for(jj=jqdpg[nodes-1]-1;jj<jqdpg[nodes-1+1]-1;jj++){
288 for(k=0;k<3;k++){
289 du[(islavnodeinv[irowdpg[jj]-1]-1)*3+k]+=Dpgd[jj]*b2[mt*nodes-3+k];
290 u_oldt[(islavnodeinv[irowdpg[jj]-1]-1)*3+k]+=
291 Dpgd[jj]*(vold[mt*(nodes)-3+k]-vini[mt*(nodes)-3+k]);
292 u_old[(islavnodeinv[irowdpg[jj]-1]-1)*3+k]+=
293 Dpgd[jj]*(vold[mt*(nodes)-3+k]);
294 }
295 }
296 }
297 for(i=0;i<*nk;i++){
298 nodes=i+1;
299 for(jj=jqbpg[nodes-1]-1;jj<jqbpg[nodes-1+1]-1;jj++){
300 for(k=0;k<3;k++){
301 du[(islavnodeinv[irowbpg[jj]-1]-1)*3+k]+=Bpgd[jj]*b2[mt*nodes-3+k];
302 u_oldt[(islavnodeinv[irowbpg[jj]-1]-1)*3+k]+=
303 Bpgd[jj]*(vold[mt*(nodes)-3+k]-vini[mt*(nodes)-3+k]);
304 u_old[(islavnodeinv[irowbpg[jj]-1]-1)*3+k]+=
305 Bpgd[jj]*(vold[mt*(nodes)-3]+k);
306 }
307 }
308 }
309 }else{
310
311 /* normal formulation */
312 /* get du^hat */
313 /* get uhat_k-1 */
314
315 for(i=0;i<*nk;i++){
316 nodes=i+1;
317 for(jj=jqd[nodes-1]-1;jj<jqd[nodes-1+1]-1;jj++){
318 for(k=0;k<3;k++){
319 du[(islavnodeinv[irowd[jj]-1]-1)*3+k]+=Dd[jj]*b2[mt*nodes-3+k];
320 u_oldt[(islavnodeinv[irowd[jj]-1]-1)*3+k]+=
321 Dd[jj]*(vold[mt*(nodes)-3+k]-vini[mt*(nodes)-3+k]);
322 u_old[(islavnodeinv[irowd[jj]-1]-1)*3+k]+=
323 Dd[jj]*(vold[mt*(nodes)-3+k]);
324 }
325 }
326 }
327 for(i=0;i<*nk;i++){
328 nodes=i+1;
329 for(jj=jqb[nodes-1]-1;jj<jqb[nodes-1+1]-1;jj++){
330 for(k=0;k<3;k++){
331 du[(islavnodeinv[irowb[jj]-1]-1)*3+k]+=Bd[jj]*b2[mt*nodes-3+k];
332 u_oldt[(islavnodeinv[irowb[jj]-1]-1)*3+k]+=
333 Bd[jj]*(vold[mt*(nodes)-3+k]-vini[mt*(nodes)-3+k]);
334 u_old[(islavnodeinv[irowb[jj]-1]-1)*3+k]+=
335 Bd[jj]*(vold[mt*(nodes)-3+k]);
336 }
337 }
338 }
339 }
340
341 /* get lambda_scaled */
342
343 for (i=0;i<*ntie;i++){
344 if(tieset[i*(81*3)+80]=='C'){
345 for(j=nslavnode[i];j<nslavnode[i+1];j++){
346 cold[3*j+0]=cstress[mt*j];
347 cold[3*j+1]=cstress[mt*j+1];
348 cold[3*j+2]=cstress[mt*j+2];
349 nodes=islavnode[j];
350 idof1=nactdof[mt*nodes-3]-1;
351 idof2=nactdof[mt*nodes-2]-1;
352 idof3=nactdof[mt*nodes-1]-1;
353 ndof=0;
354 if(idof1>-1){ndof++;}if(idof2>-1){ndof++;}if(idof3>-1){ndof++;}
355 for(k=0;k<3;k++){
356 idof=nactdof[mt*nodes-3+k]-1;
357 if(idof>-1) {
358 cstress[mt*j+k]=cstress2[idof];
359 }else{
360 cstress[mt*j+k]=0.0;
361 for(jj=nslavmpc2[2*(j)];jj<nslavmpc2[2*(j)+1];jj++){
362 ist=islavmpc2[2*jj];
363 dirdep=nodempc2[3*(ist-1)+1];
364 coefdep=coefmpc2[ist-1];
365 index=nodempc2[3*(ist-1)+2];
366 if(dirdep==k+1){
367 while(index!=0){
368 dirind=nodempc2[3*(index-1)+1];
369 node2=nodempc2[3*(index-1)];
370 ch=0.0;
371 if(node2>*nk){
372 idof=-1;
373 }else{
374 idof=nactdof[mt*node2-3+(dirind-1)]-1;
375 }
376 if(idof>-1){
377 ch=cstress2[idof];
378 }
379 cstress[mt*j+dirdep-1]=cstress[mt*j+dirdep-1]-
380 coefmpc2[index-1]*ch/coefdep;
381 index=nodempc2[3*(index-1)+2];
382 }
383 }
384 }
385 }
386 }
387 }
388 }
389 }
390
391 /** generate cstressini2,cstresstil **/
392
393 for (i=0;i<*ntie;i++){
394 if(tieset[i*(81*3)+80]=='C'){
395 for(j=nslavnode[i];j<nslavnode[i+1];j++){
396 nodes=islavnode[j];
397 for(jj=jqdtil[nodes-1]-1;jj<jqdtil[nodes-1+1]-1;jj++){
398 for(l=0;l<3;l++){
399 cstresstil[(islavnodeinv[irowdtil[jj]-1]-1)*mt+l]+=
400 Ddtil[jj]*cstress[(islavnodeinv[nodes-1]-1)*mt+l];
401 cstressini2[(islavnodeinv[irowdtil[jj]-1]-1)*mt+l]+=
402 Ddtil[jj]*cstressini[(islavnodeinv[nodes-1]-1)*mt+l];
403 cold2[(islavnodeinv[irowdtil[jj]-1]-1)*3+l]+=
404 Ddtil[jj]*cold[(islavnodeinv[nodes-1]-1)*3+l];
405 }
406 }
407 }
408 }
409 }
410
411 /* update slave nodes according to semi-smooth Newton */
412
413 for (i=0;i<*ntie;i++){
414 if(tieset[i*(81*3)+80]=='C'){
415 for(j=nslavnode[i];j<nslavnode[i+1];j++){
416 nodes=islavnode[j];
417 idof1=nactdof[mt*nodes-3]-1;
418 idof2=nactdof[mt*nodes-2]-1;
419 idof3=nactdof[mt*nodes-1]-1;
420 ndof=0;
421 if(idof1>-1){ndof++;}if(idof2>-1){ndof++;}if(idof3>-1){ndof++;}
422 FORTRAN(getcontactparams,(&mu,®mode,®modet,&aninvloc,&atauinvloc,
423 &p0,&beta,tietol,elcon,&i,ncmat_,ntmat_,
424 &iwan));
425 mumax=max(mu,mumax);
426 stressnormal=cstresstil[mt*j+0]*slavnor[3*j]+
427 cstresstil[mt*j+1]*slavnor[3*j+1]+cstresstil[mt*j+2]*slavnor[3*j+2];
428 stresst[0]=cstresstil[mt*j+0]*slavtan[6*j]+
429 cstresstil[mt*j+1]*slavtan[6*j+1]+cstresstil[mt*j+2]*slavtan[6*j+2];
430 stresst[1]=cstresstil[mt*j+0]*slavtan[6*j+3]+
431 cstresstil[mt*j+1]*slavtan[6*j+4]+cstresstil[mt*j+2]*slavtan[6*j+5];
432 stressinit[0]=cstressini2[mt*j+0]*slavtan[6*j]+
433 cstressini2[mt*j+1]*slavtan[6*j+1]+
434 cstressini2[mt*j+2]*slavtan[6*j+2];
435 stressinit[1]=cstressini2[mt*j+0]*slavtan[6*j+3]+
436 cstressini2[mt*j+1]*slavtan[6*j+4]+
437 cstressini2[mt*j+2]*slavtan[6*j+5];
438 stresstildet[0]=(stresst[0]-stressinit[0]);
439 stresstildet[1]=(stresst[1]-stressinit[1]);
440 ddispnormal=du[3*j+0]*slavnor[3*j]+du[3*j+1]*slavnor[3*j+1]+
441 du[3*j+2]*slavnor[3*j+2];
442 ddispt[0]=du[3*j+0]*slavtan[6*j]+du[3*j+1]*slavtan[6*j+1]+
443 du[3*j+2]*slavtan[6*j+2];
444 ddispt[1]=du[3*j+0]*slavtan[6*j+3]+du[3*j+1]*slavtan[6*j+4]+
445 du[3*j+2]*slavtan[6*j+5];
446 disp_totalnormal=(du[3*j+0]+u_oldt[j*3])*slavnor[3*j]
447 +(du[3*j+1]+u_oldt[j*3+1])*slavnor[3*j+1]
448 +(du[3*j+2]+u_oldt[j*3+2])*slavnor[3*j+2];
449 disp_tildet[0]=(du[3*j+0]+u_oldt[j*3])*slavtan[6*j]
450 +(du[3*j+1]+u_oldt[j*3+1])*slavtan[6*j+1]
451 +(du[3*j+2]+u_oldt[j*3+2])*slavtan[6*j+2];
452 disp_tildet[1]=(du[3*j+0]+u_oldt[j*3])*slavtan[6*j+3]
453 +(du[3*j+1]+u_oldt[j*3+1])*slavtan[6*j+4]
454 +(du[3*j+2]+u_oldt[j*3+2])*slavtan[6*j+5];
455 disp_tildeto[0]=(u_oldt[j*3])*slavtan[6*j]
456 +(u_oldt[j*3+1])*slavtan[6*j+1]
457 +(u_oldt[j*3+2])*slavtan[6*j+2];
458 disp_tildeto[1]=(u_oldt[j*3])*slavtan[6*j+3]
459 +(u_oldt[j*3+1])*slavtan[6*j+4]
460 +(u_oldt[j*3+2])*slavtan[6*j+5];
461 disp_t[0]=(du[3*j+0]+u_old[j*3])*slavtan[6*j]
462 +(du[3*j+1]+u_old[j*3+1])*slavtan[6*j+1]
463 +(du[3*j+2]+u_old[j*3+2])*slavtan[6*j+2];
464 disp_t[1]=(du[3*j+0]+u_old[j*3])*slavtan[6*j+3]
465 +(du[3*j+1]+u_old[j*3+1])*slavtan[6*j+4]
466 +(du[3*j+2]+u_old[j*3+2])*slavtan[6*j+5];
467 ln_old=cold2[3*j+0]*slavnor[3*j]+cold2[3*j+1]*slavnor[3*j+1]+
468 cold2[3*j+2]*slavnor[3*j+2];
469 bpold=bp[j];
470
471 double gnc_old,dgnc_old;
472 derivmode=0;
473 if(islavact[j]>-1){scal=Ddtil[jqdtil[nodes-1]-1];}else{scal=0.0;}
474 FORTRAN(regularization_gn_c,(&ln_old,&derivmode,®mode,&gnc_old,
475 &aninvloc,&p0,&beta,elcon,nelcon,&i,
476 ntmat_,plicon,nplicon,npmat_,ncmat_,
477 tietol,&scal));
478 derivmode=1;
479 FORTRAN(regularization_gn_c,(&ln_old,&derivmode,®mode,&dgnc_old,
480 &aninvloc,&p0,&beta,elcon,nelcon,&i,ntmat_,
481 plicon,nplicon,npmat_,ncmat_,tietol,
482 &scal));
483 derivmode=0;
484 FORTRAN(regularization_gn_c,(&stressnormal,&derivmode,®mode,&gnc,
485 &aninvloc,&p0,&beta,elcon,nelcon,&i,ntmat_,
486 plicon,nplicon,npmat_,ncmat_,tietol,
487 &scal));
488
489 derivmode=0;
490 FORTRAN(regularization_gt_c,(stresstildet,&derivmode,®modet,gtc,
491 &atauinvloc));
492
493 constantt=min(constant,1.0/atauinvloc);
494 constantn=constant;
495
496 if(mu>1.E-10){
497 bp[j]=mu*(stressnormal+constantn*(ddispnormal-gap[j]-gnc));
498 }else{
499 bp[j]=(stressnormal+constantn*(ddispnormal-gap[j]-gnc));
500 }
501 yielded=0;
502 resreg[0]=0.0;resreg[1]=0.0;
503 if(regmodet==2 && islavact[j]>0){
504 jj=j+1;
505 atau2=1.0/atauinvloc;
506 n[0]=slavnor[3*j];n[1]=slavnor[3*j+1];n[2]=slavnor[3*j+2];
507 for(k=0;k<6;k++){t[k]=slavtan[6*j+k];}
508 derivmode=0;
509
510 // update lambdaiwan
511
512 regmode=2;
513 FORTRAN(regularization_slip_iwan,(&stressnormal,disp_tildeto,&bpold,
514 &atau2,resreg2,&derivmode,®mode,
515 lambdaiwan,lambdaiwanini,&jj,n,t,
516 &mu,rslip,ltslip,ltu,&yielded,
517 &nodes,&debug,&iwan,ddispt));
518 bpold=max(0.0,bp[j]);
519
520 // calc resreg
521
522 regmode=1;
523 FORTRAN(regularization_slip_iwan,(&stressnormal,disp_tildet,&bpold,
524 &atau2,resreg,&derivmode,®mode,
525 lambdaiwan,lambdaiwanini,&jj,n,t,
526 &mu,rslip,ltslip,ltu,&yielded,
527 &nodes,&debug,&iwan,ddispt));
528 }
529
530 disp_t2[0]=stressinit[0]+constantt*disp_tildet[0];
531 disp_t2[1]=stressinit[1]+constantt*disp_tildet[1];
532
533 w_t[0]=stresst[0]+constantt*(disp_tildet[0]-gtc[0]);
534 w_t[1]=stresst[1]+constantt*(disp_tildet[1]-gtc[1]);
535 nw_t=sqrt(w_t[0]*w_t[0]+w_t[1]*w_t[1]);
536 ncf_t[0]=0.0;ncf_t[1]=0.0;ncf_n=0.0;
537
538 /* evaluate non-linear complementary functions
539 (Sitzmann,Equation (3.54),(3.65)) */
540
541 if(mu>1.E-10){
542 ncf_n=mu*stressnormal-max(0.0,bp[j]);
543 if(regmodet==1){
544 if(islavact[j]==0){
545 ncf_t[0]=stresst[0];
546 ncf_t[1]=stresst[1];
547 }else if(islavact[j]==1){
548 ncf_t[0]=disp_tildet[0]-gtc[0];
549 ncf_t[1]=disp_tildet[1]-gtc[1];
550 }else if(islavact[j]==2){
551 ncf_t[0]=stresst[0]-bp[j]*w_t[0]/nw_t;
552 ncf_t[1]=stresst[1]-bp[j]*w_t[1]/nw_t;
553 }else{
554 ncf_t[0]=0.0;ncf_t[1]=0.0;
555 }
556 }else{
557 if(islavact[j]==2){
558 ncf_t[0]=stresst[0]-resreg[0];
559 ncf_t[1]=stresst[1]-resreg[1];
560 }else{
561 ncf_t[0]=stresst[0];
562 ncf_t[1]=stresst[1];
563 }
564 }
565 }else{
566 ncf_n=stressnormal-max(0.0,bp[j]);
567 ncf_t[0]=0.0;ncf_t[1]=0.0;
568 }
569 if( ncf_n<0.0)ncf_n=-ncf_n;
570 if( ncf_t[0]<0.0)ncf_t[0]=-ncf_t[0];
571 if( ncf_t[1]<0.0)ncf_t[1]=-ncf_t[1];
572 if(ncf_n>max_ncf_n && ndof>0 && islavact[j]>-1){max_ncf_n=ncf_n;
573 node_max_ncf_n=nodes;}
574 if(ncf_t[0]>max_ncf_t[0] && ndof>0 && islavact[j]>-1){
575 max_ncf_t[0]=ncf_t[0];node_max_ncf_t[0]=nodes;}
576 if(ncf_t[1]>max_ncf_t[1] && ndof>0 && islavact[j]>-1){
577 max_ncf_t[1]=ncf_t[1];node_max_ncf_t[1]=nodes;}
578 if(debug==1 ){
579 printf("u(%" ITGFORMAT "): %" ITGFORMAT " %" ITGFORMAT " %"
580 ITGFORMAT " act %" ITGFORMAT " %" ITGFORMAT "\n",nodes,
581 idof1+1,idof2+1,idof3+1,islavact[j],yielded);
582 if(regmodet==2){
583 printf("\t resreg2-lmt %e %e \n",resreg2[0]-stresst[0],
584 resreg2[1]-stresst[1]);
585 }
586 printf("\t resreg %e %e bp %e \n",resreg[0],resreg[1],bp[j]);
587 printf("\t lmtilde %e %e utilde %e %e gtc %e %e \n",stresstildet[0],
588 stresstildet[1],disp_tildet[0],disp_tildet[1],gtc[0],gtc[1]);
589 printf("\t w_t2 %e %e \n",disp_t2[0],disp_t2[1]);
590 printf("\t uhat(%" ITGFORMAT ") : %e %e %e \n",nodes,du[3*j+0],
591 du[3*j+1],du[3*j+2]);
592 printf("\t u2(%" ITGFORMAT "): %e \n",nodes,ddispnormal);
593 printf("\t u_tot2(%" ITGFORMAT "): %e %e %e \n",nodes,
594 disp_totalnormal,disp_t[0],disp_t[1]);
595 printf("\t cstress(%" ITGFORMAT "): %e %e %e,actif: %" ITGFORMAT
596 " \n",nodes,cstress[mt*j+0],cstress[mt*j+1],cstress[mt*j+2],
597 islavact[j]);
598 printf("\t cstresstil(%" ITGFORMAT "): %e %e %e\n",nodes,
599 cstresstil[mt*j+0],cstresstil[mt*j+1],cstresstil[mt*j+2]);
600 printf("\t lm(%" ITGFORMAT ") : %e %e %e \n",nodes,
601 stressnormal,stresst[0],stresst[1]);
602 printf("\t newton eq. n: %e=%e diff %e \n",
603 ddispnormal-dgnc_old*stressnormal,
604 gap[j]+gnc_old-dgnc_old*ln_old,
605 ddispnormal-dgnc_old*stressnormal-
606 (gap[j]+gnc_old-dgnc_old*ln_old));
607 printf("\t u_n %e -dgnc_o*ln %e =gap %e +gnc_o %e -dgnc_o*lo %e\n",
608 ddispnormal,dgnc_old*stressnormal,gap[j],gnc_old,
609 dgnc_old*ln_old);
610 printf("\t ln %e bp/c %e disp-gap %e gnc(ln) %e \n",stressnormal,
611 ddispnormal-gap[j]-gnc,ddispnormal-gap[j],gnc);
612 if(mu>1.E-10){
613 printf("\t uh_t1= %e uh_t2= %e nuh_t= %e \n",disp_tildet[0],
614 disp_tildet[1],sqrt(disp_tildet[0]*disp_tildet[0]+
615 disp_tildet[1]*disp_tildet[1])) ;
616 printf("\t w_t1= %e w_t2= %e nw_t= %e \n",w_t[0],w_t[1],nw_t);
617 printf("\t ncf_n %e ncf_t %e %e\n",ncf_n,ncf_t[0],ncf_t[1]);
618 if(islavact[j]==1){
619 printf("stick: nlmt %e < bp %e and utildetau-lmtildetau %e %e =0?\n",sqrt((stresst[0])*(stresst[0])+(stresst[1])*(stresst[1])),bp[j],disp_tildet[0]-gtc[0],disp_tildet[1]-gtc[1]);
620 }else if(islavact[j]==2){
621 printf("slip: nlmt %e=bp %e and utildetau-lmtildetau %e %e >0? \n",sqrt((stresst[0])*(stresst[0])+(stresst[1])*(stresst[1])),bp[j],
622 disp_tildet[0]-gtc[0],disp_tildet[1]-gtc[1]);
623 }
624 }
625 }
626 debug=0;
627
628 if(keepset==0){
629 if(mu>1.E-10){ //contact tie with friction
630 if (islavact[j]>-1){
631 if(regmodet==1){
632
633 /*** Active/Inactive set condition cf:
634 Sitzmann Equation (3.58),(3.70) ***/
635
636 if(bp[j]>-1E-10 && nw_t<(bp[j])){
637 nstick++;
638 if (islavact[j]!=1) {*iflagact=1;}
639 islavact[j]=1;
640 cdisp[6*j]=gap[j]-ddispnormal;
641 cdisp[6*j+1]=disp_t[0];
642 cdisp[6*j+2]=disp_t[1];
643 cdisp[6*j+3]=stressnormal;
644 cdisp[6*j+4]=stresst[0];
645 cdisp[6*j+5]=stresst[1];
646 lm_t1_av=lm_t1_av+abs(stresst[0]);
647 lm_t2_av=lm_t2_av+abs(stresst[1]);
648 }else if(bp[j]>-1E-10 && nw_t>=(bp[j])){
649 nslip++;
650 if (islavact[j]!=2) {*iflagact=1;}
651 islavact[j]=2;
652 cdisp[6*j]=gap[j]-ddispnormal;
653 cdisp[6*j+1]=disp_t[0];
654 cdisp[6*j+2]=disp_t[1];
655 cdisp[6*j+3]=stressnormal;
656 cdisp[6*j+4]=stresst[0];
657 cdisp[6*j+5]=stresst[1];
658 lm_t1_av=lm_t1_av+abs(stresst[0]);
659 lm_t2_av=lm_t2_av+abs(stresst[1]);
660 }else{
661 if (islavact[j]>0){ *iflagact=1;}
662 ninacti++;
663 islavact[j]=0;
664 cstress[mt*j+0]=0.;
665 cstress[mt*j+1]=0.;
666 cstress[mt*j+2]=0.;
667 cdisp[6*j]=gap[j]-ddispnormal;
668 cdisp[6*j+1]=0.;
669 cdisp[6*j+2]=0.;
670 cdisp[6*j+3]=0.;
671 cdisp[6*j+4]=0.;
672 cdisp[6*j+5]=0.;
673 if(idof1>-1)cstress2[idof1]=0.0;
674 if(idof2>-1)cstress2[idof2]=0.0;
675 if(idof3>-1)cstress2[idof3]=0.0;
676 }
677 }else{
678 if(bp[j]>-1E-10){
679 nslip++;
680 if (islavact[j]!=2) {*iflagact=1;}
681 islavact[j]=2;
682 cdisp[6*j]=gap[j]-ddispnormal;
683 cdisp[6*j+1]=disp_t[0];
684 cdisp[6*j+2]=disp_t[1];
685 cdisp[6*j+3]=stressnormal;
686 cdisp[6*j+4]=stresst[0];
687 cdisp[6*j+5]=stresst[1];
688
689 }else{
690 if (islavact[j]>0){ *iflagact=1;}
691 ninacti++;
692 islavact[j]=0;
693 cstress[mt*j+0]=0.;
694 cstress[mt*j+1]=0.;
695 cstress[mt*j+2]=0.;
696 cdisp[6*j]=gap[j]-ddispnormal;
697 cdisp[6*j+1]=0.;
698 cdisp[6*j+2]=0.;
699 cdisp[6*j+3]=0.;
700 cdisp[6*j+4]=0.;
701 cdisp[6*j+5]=0.;
702 if(idof1>-1)cstress2[idof1]=0.0;
703 if(idof2>-1)cstress2[idof2]=0.0;
704 if(idof3>-1)cstress2[idof3]=0.0;
705 if(regmodet==2){
706 for(k=0;k<3*iwan;k++){
707 lambdaiwan[3*iwan*j+k]=0.0;
708 }
709 }
710 }
711 }
712 }else{
713
714 /* nodes without LM contribution */
715
716 if(islavact[j]==-1){
717 nnogap++;
718 }else if(islavact[j]==-2){
719 nolm++;
720 }
721 cstress[mt*j+0]=0.;
722 cstress[mt*j+1]=0.;
723 cstress[mt*j+2]=0.;
724 cdisp[6*j]=0.;
725 cdisp[6*j+1]=0.;
726 cdisp[6*j+2]=0.;
727 cdisp[6*j+3]=0.;
728 cdisp[6*j+4]=0.;
729 cdisp[6*j+5]=0.;
730 if(idof1>-1)cstress2[idof1]=0.0;
731 if(idof2>-1)cstress2[idof2]=0.0;
732 if(idof3>-1)cstress2[idof3]=0.0;
733 if(regmodet==2){
734 for(k=0;k<3*iwan;k++){
735 lambdaiwan[3*iwan*j+k]=0.0;
736 }
737 }
738 }
739 }else{ //no friction
740 if (islavact[j]>-1){
741
742 /*** Active/Inactive set condition cf:
743 Sitzmann Equation (3.58) ***/
744
745 if(bp[j]>-1E-10){
746 nslip++;
747 if (islavact[j]!=2) {*iflagact=1;}
748 islavact[j]=2;
749 cdisp[6*j]=gap[j]-ddispnormal;
750 cdisp[6*j+1]=disp_t[0];
751 cdisp[6*j+2]=disp_t[1];
752 cdisp[6*j+3]=stressnormal;
753 cdisp[6*j+4]=stresst[0];
754 cdisp[6*j+5]=stresst[1];
755 }else{
756 if (islavact[j]!=0){ *iflagact=1;}
757 ninacti++;
758 islavact[j]=0;
759 cstress[mt*j+0]=0.;
760 cstress[mt*j+1]=0.;
761 cstress[mt*j+2]=0.;
762 cdisp[6*j]=ddispnormal-gap[j];
763 cdisp[6*j+1]=0.;
764 cdisp[6*j+2]=0;
765 cdisp[6*j+3]=0.;
766 cdisp[6*j+4]=0.;
767 cdisp[6*j+5]=0.;
768 if(idof1>-1)cstress2[idof1]=0.0;
769 if(idof2>-1)cstress2[idof2]=0.0;
770 if(idof3>-1)cstress2[idof3]=0.0;
771 }
772 }else{
773
774 /* nodes without LM contribution */
775
776 if(islavact[j]==-1){
777 nnogap++;
778 }else{
779 nolm++;
780 }
781 cstress[mt*j+0]=0.;
782 cstress[mt*j+1]=0.;
783 cstress[mt*j+2]=0.;
784 cdisp[6*j]=0.;
785 cdisp[6*j+1]=0.;
786 cdisp[6*j+2]=0.0;
787 cdisp[6*j+3]=0.;
788 cdisp[6*j+4]=0.;
789 cdisp[6*j+5]=0.;
790 if(idof1>-1)cstress2[idof1]=0.0;
791 if(idof2>-1)cstress2[idof2]=0.0;
792 if(idof3>-1)cstress2[idof3]=0.0;
793 }
794 }
795 }else{
796
797 /* in case active set is fixed */
798
799 if(islavact[j]>0){
800 cdisp[6*j]=gap[j]-ddispnormal;
801 cdisp[6*j+1]=disp_t[0];
802 cdisp[6*j+2]=disp_t[1];
803 cdisp[6*j+3]=stressnormal;
804 cdisp[6*j+4]=stresst[0];
805 cdisp[6*j+5]=stresst[1];
806
807 }else{
808 cstress[mt*j+0]=0.;
809 cstress[mt*j+1]=0.;
810 cstress[mt*j+2]=0.;
811 cdisp[6*j]=ddispnormal-gap[j];
812 cdisp[6*j+1]=0.;
813 cdisp[6*j+2]=0;
814 cdisp[6*j+3]=0.;
815 cdisp[6*j+4]=0.;
816 cdisp[6*j+5]=0.;
817 if(idof1>-1)cstress2[idof1]=0.0;
818 if(idof2>-1)cstress2[idof2]=0.0;
819 if(idof3>-1)cstress2[idof3]=0.0;
820 }
821 }
822
823 /* update weighted dual gap */
824
825 gap[j]=gap[j]-ddispnormal;
826 }
827 }
828 }
829
830 if(debug==1){
831 if(keepset==1)printf("stressmortar_fric2: keep active set!!!\n");
832
833 printf("\n max_ncf_n %e node %" ITGFORMAT "\n",max_ncf_n,node_max_ncf_n);
834 printf(" max_ncf_t %e %e node %" ITGFORMAT " av %e\n",max_ncf_t[0],
835 max_ncf_t[0]/((lm_t1_av+0.001)/(nstick+nslip+0.001)),
836 node_max_ncf_t[0],((lm_t1_av+0.001)/(nstick+nslip+0.001)));
837 printf(" max_ncf_t %e %e node %" ITGFORMAT " av %e\n",max_ncf_t[1],
838 max_ncf_t[1]/((lm_t2_av+0.001)/(nstick+nslip+0.001)),
839 node_max_ncf_t[1],((lm_t2_av+0.001)/(nstick+nslip+0.001)));
840 }
841
842 if(keepset==0){
843
844 /* relative convergence critera for semi-smooth Newton */
845
846 if(max_ncf_n>1.e-3 ){*iflagact=1;}
847 if((max_ncf_t[0]/((lm_t1_av+0.001)/(nstick+nslip+0.001))>9.e-4 ||
848 max_ncf_t[1]/((lm_t2_av+0.001)/(nstick+nslip+0.001))>9.e-4) &&
849 mumax>1.E-10 ){*iflagact=1;}
850 }
851
852 SFREE(unitmatrix);
853
854 /* calculating the contact forces
855 Ph.D. Thesis Stefan Hartmann eqn. (6.26) */
856 // fill cstress for nogap nodes
857
858 for(i=0;i<mt**nk;i++){cfs[i]=0.0;}
859 if(*nmethod==4){for(i=0;i<mt**nk;i++){cfstil[i]=0.0;}}
860
861 // get contact forces
862
863 for(i=0;i<*nk;i++){
864 for(j=jqd[i]-1;j<jqd[i+1]-1;j++){
865 for(l=0;l<3;l++){
866 cfs[mt*(i+1)-3+l]+=Dd[j]*cstress[mt*(islavnodeinv[irowd[j]-1]-1)+l];
867 }
868 }
869 }
870 for(i=0;i<*nk;i++){
871 for(j=jqb[i]-1;j<jqb[i+1]-1;j++){
872 for(l=0;l<3;l++){
873 cfs[mt*(i+1)-3+l]+=Bd[j]*cstress[mt*(islavnodeinv[irowb[j]-1]-1)+l];
874 }
875 }
876 }
877 if(*nmethod==4){
878 for(i=0;i<*nk;i++){
879 for(j=jqdtil[i]-1;j<jqdtil[i+1]-1;j++){
880 for(l=0;l<3;l++){
881 cfstil[mt*(i+1)-3+l]+=Ddtil[j]*
882 cstress[mt*(islavnodeinv[irowdtil[j]-1]-1)+l];
883 }
884 }
885 }
886 for(i=0;i<*nk;i++){
887 for(j=jqbtil[i]-1;j<jqbtil[i+1]-1;j++){
888 for(l=0;l<3;l++){
889 cfstil[mt*(i+1)-3+l]+=Bdtil[j]*
890 cstress[mt*(islavnodeinv[irowbtil[j]-1]-1)+l];
891 }
892
893 }
894 }
895
896 for(i=0;i<mt**nk;i++){cfsini[i]=0.0;}
897 for(i=0;i<*nk;i++){
898 for(j=jqd[i]-1;j<jqd[i+1]-1;j++){
899 for(l=0;l<3;l++){
900 cfsini[mt*(i+1)-3+l]+=
901 Dd[j]*cstressini[mt*(islavnodeinv[irowd[j]-1]-1)+l];
902 }
903 }
904 }
905 for(i=0;i<*nk;i++){
906 for(j=jqb[i]-1;j<jqb[i+1]-1;j++){
907 for(l=0;l<3;l++){
908 cfsini[mt*(i+1)-3+l]+=
909 Bd[j]*cstressini[mt*(islavnodeinv[irowb[j]-1]-1)+l];
910 }
911 }
912 }
913
914 }
915
916 NNEW(fmpc,double,*nmpc);
917 NNEW(rc,double,*nk*mt);
918 calcul_fn=1;
919 calcul_f=1;
920 for(i=0;i<*nk;i++){
921 for(l=0;l<3;l++){
922 if(*nmethod==4){
923
924 /* modification for dynamic calculations */
925 /* Sitzmann Equation (5.12) */
926
927 rc[mt*(i+1)-3+l]=cfs[mt*(i+1)-3+l]*(1+alpha)-cfsini[mt*(i+1)-3+l]*
928 (alpha);
929 }else{
930 rc[mt*(i+1)-3+l]=cfs[mt*(i+1)-3+l];
931 }
932 }
933 }
934
935 resultsforc(nk,f_cs,rc,nactdof,ipompc,nodempc,coefmpc,labmpc,nmpc,mi,fmpc,
936 &calcul_fn,&calcul_f,&num_cpus);
937 SFREE(fmpc);
938
939 /* print total contact force per contact tie for debugging purpose */
940
941 for( i=0; i<*ntie; i++){
942 if(tieset[i*(81*3)+80]=='C'){
943 for(jj=0;jj<3;jj++){
944 f_cs_tot[jj]=0.0;
945 f_cm_tot[jj]=0.0;
946 }
947 for(j=nslavnode[i]; j<nslavnode[i+1]; j++){
948 nodes=islavnode[j];
949 for(l=0;l<3;l++){
950 idof1=nactdof[mt*nodes-3+l]-1;
951 if(idof1>-1){
952 f_cs_tot[l]+=f_cs[idof1];
953 f_cs_tot[l]+=f_cm[idof1];
954 }
955 }
956 }
957 for(j=nmastnode[i]; j<nmastnode[i+1]; j++){
958 nodes=imastnode[j];
959 for(l=0;l<3;l++){
960 idof1=nactdof[mt*nodes-3+l]-1;
961 if(idof1>-1){
962 f_cm_tot[l]+=f_cs[idof1];
963
964 }
965 }
966 }
967 f_csn=sqrt(f_cs_tot[0]*f_cs_tot[0]+f_cs_tot[1]*f_cs_tot[1]+
968 f_cs_tot[2]*f_cs_tot[2]);
969 f_cmn=sqrt(f_cm_tot[0]*f_cm_tot[0]+f_cm_tot[1]*f_cm_tot[1]+
970 f_cm_tot[2]*f_cm_tot[2]);
971 if(ithermal[0]==3){
972 }else{
973 if(debug==1){
974 printf("\n tie %" ITGFORMAT
975 " slave contact force : %e %e %e and norm: %e \n",i+1,
976 f_cs_tot[0],f_cs_tot[1],f_cs_tot[2],f_csn);
977 printf(" tie %" ITGFORMAT
978 " master contact force: %e %e %e and norm: %e \n",i+1,
979 f_cm_tot[0],f_cm_tot[1],f_cm_tot[2],f_cmn );
980 }
981 }
982 }
983 }
984
985 /* transform contact traction for frd-output I(LM)=T*LM */
986
987 for( i=0; i<*ntie; i++){
988 if(tieset[i*(81*3)+80]=='C'){
989 for(j=nslavnode[i]; j<nslavnode[i+1]; j++){
990 for(jj=0;jj<mt;jj++){
991 cstresstil[mt*j+jj]=0.0;
992 }
993 }
994 }
995 }
996 for(i=0;i<*nk;i++){
997 nodes=i+1;
998 for(jj=jqtloc[nodes-1]-1;jj<jqtloc[nodes-1+1]-1;jj++){
999 for(l=0;l<3;l++){
1000 idof1=mt*(islavnodeinv[nodes-1]-1)+l;
1001 idof2=mt*(islavnodeinv[irowtloc[jj]-1]-1)+l;
1002 cstresstil[idof2]+=autloc[jj]*cstress[idof1];
1003 }
1004 }
1005 }
1006 for( i=0; i<*ntie; i++){
1007 if(tieset[i*(81*3)+80]=='C'){
1008 for(j=nslavnode[i]; j<nslavnode[i+1]; j++){
1009 stressnormal=cstresstil[mt*j+0]*slavnor[3*j]+
1010 cstresstil[mt*j+1]*slavnor[3*j+1]+cstresstil[mt*j+2]*slavnor[3*j+2];
1011 stresst[0]=cstresstil[mt*j+0]*slavtan[6*j]+
1012 cstresstil[mt*j+1]*slavtan[6*j+1]+cstresstil[mt*j+2]*slavtan[6*j+2];
1013 stresst[1]=cstresstil[mt*j+0]*slavtan[6*j+3]+
1014 cstresstil[mt*j+1]*slavtan[6*j+4]+cstresstil[mt*j+2]*slavtan[6*j+5];
1015 cdisp[6*j+3]=stressnormal;
1016 cdisp[6*j+4]=stresst[0];
1017 cdisp[6*j+5]=stresst[1];
1018 }
1019 }
1020 }
1021
1022 /* needed for adaptive time stepping */
1023
1024 if(*iit>ndiverg){*iflagact=0;}
1025
1026 if(debug==1){
1027 printf("\n contacstress : N_stick : %" ITGFORMAT "\t N_slip : %" ITGFORMAT
1028 "\tN_Inactiv : %" ITGFORMAT "\t N_nogap : %" ITGFORMAT " N_nolm : %"
1029 ITGFORMAT "\n Flag=%" ITGFORMAT "\n",nstick,nslip,ninacti,nnogap,
1030 nolm,*iflagact);
1031 printf(" stressmortar : ndiverg %" ITGFORMAT " \n",ndiverg);
1032 }
1033
1034 SFREE(bhat2);
1035 SFREE(b2);
1036 SFREE(cstress2);
1037 SFREE(u_old);
1038 SFREE(u_oldt);
1039 SFREE(du);
1040 SFREE(cstresstil);
1041 SFREE(cstressini2);
1042 SFREE(cold);
1043 SFREE(cold2);
1044 SFREE(vectornull);
1045 SFREE(rc);
1046 return;
1047 }
1048