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,&regmode,&regmodet,&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,&regmode,&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,&regmode,&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,&regmode,&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,&regmodet,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,&regmode,
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,&regmode,
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