void frdcyc(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,double *v, double *stn,ITG *inum,ITG *nmethod,ITG *kode,char *filab, double *een,double *t1,double *fn,double *time,double *epn, ITG *ielmat,char *matname, double *cs, ITG *mcs, ITG *nkon, double *enern, double *xstaten, ITG *nstate_, ITG *istep, ITG *iinc, ITG *iperturb, double *ener, ITG *mi, char *output, ITG *ithermal, double *qfn, ITG *ialset, ITG *istartset, ITG *iendset, double *trab, ITG *inotr, ITG *ntrans, double *orab, ITG *ielorien, ITG *norien, double *sti, double *veold, ITG *noddiam,char *set,ITG *nset, double *emn, double *thicke,char* jobnamec,ITG *ne0,double *cdn,ITG *mortar,ITG *nmat){ /* duplicates fields for static cyclic symmetric calculations */ char *lakont=NULL,description[13]=" "; ITG nkt,icntrl,*kont=NULL,*ipkont=NULL,*inumt=NULL,*ielmatt=NULL,net,i,l, imag=0,mode=-1,ngraph,*inocs=NULL,*ielcs=NULL,l1,l2,is, jj,node,i1,i2,nope,iel,indexe,j,ielset,*inotrt=NULL,mt=mi[1]+1, *ipneigh=NULL,*neigh=NULL,net0; double *vt=NULL,*fnt=NULL,*stnt=NULL,*eent=NULL,*cot=NULL,*t1t=NULL, *epnt=NULL,*enernt=NULL,*xstatent=NULL,theta,pi,t[3],*qfnt=NULL, *vr=NULL,*vi=NULL,*stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL, *stit=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,*emnt=NULL,*qfx=NULL, *cdnr=NULL,*cdni=NULL; pi=4.*atan(1.); /* determining the maximum number of sectors to be plotted */ ngraph=1; for(j=0;j<*mcs;j++){ if(cs[17*j+4]>ngraph) ngraph=cs[17*j+4]; } /* assigning nodes and elements to sectors */ NNEW(inocs,ITG,*nk); NNEW(ielcs,ITG,*ne); ielset=cs[12]; if((*mcs!=1)||(ielset!=0)){ for(i=0;i<*nk;i++) inocs[i]=-1; for(i=0;i<*ne;i++) ielcs[i]=-1; } for(i=0;i<*mcs;i++){ is=cs[17*i+4]; if(is==1) continue; ielset=cs[17*i+12]; if(ielset==0) continue; for(i1=istartset[ielset-1]-1;i1<iendset[ielset-1];i1++){ if(ialset[i1]>0){ iel=ialset[i1]-1; if(ipkon[iel]<0) continue; ielcs[iel]=i; indexe=ipkon[iel]; if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20; else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8; else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10; else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4; else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15; else {nope=6;} for(i2=0;i2<nope;++i2){ node=kon[indexe+i2]-1; inocs[node]=i; } } else{ iel=ialset[i1-2]-1; do{ iel=iel-ialset[i1]; if(iel>=ialset[i1-1]-1) break; if(ipkon[iel]<0) continue; ielcs[iel]=i; indexe=ipkon[iel]; if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20; else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8; else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10; else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4; else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15; else {nope=6;} for(i2=0;i2<nope;++i2){ node=kon[indexe+i2]-1; inocs[node]=i; } }while(1); } } } NNEW(cot,double,3**nk*ngraph); if(*ntrans>0)NNEW(inotrt,ITG,2**nk*ngraph); if((strcmp1(&filab[0],"U ")==0)|| ((strcmp1(&filab[87],"NT ")==0)&&(*ithermal>=2))) NNEW(vt,double,mt**nk*ngraph); if((strcmp1(&filab[87],"NT ")==0)&&(*ithermal<2)) NNEW(t1t,double,*nk*ngraph); if((strcmp1(&filab[174],"S ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)|| (strcmp1(&filab[1044],"ERR ")==0)) NNEW(stnt,double,6**nk*ngraph); if(strcmp1(&filab[261],"E ")==0) NNEW(eent,double,6**nk*ngraph); if((strcmp1(&filab[348],"RF ")==0)||(strcmp1(&filab[783],"RFL ")==0)) NNEW(fnt,double,mt**nk*ngraph); if(strcmp1(&filab[435],"PEEQ")==0) NNEW(epnt,double,*nk*ngraph); if(strcmp1(&filab[522],"ENER")==0) NNEW(enernt,double,*nk*ngraph); if(strcmp1(&filab[609],"SDV ")==0) NNEW(xstatent,double,*nstate_**nk*ngraph); if(strcmp1(&filab[696],"HFL ")==0) NNEW(qfnt,double,3**nk*ngraph); if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)|| (strcmp1(&filab[2175],"CONT")==0)) NNEW(stit,double,6*mi[0]**ne*ngraph); if(strcmp1(&filab[2697],"ME ")==0) NNEW(emnt,double,6**nk*ngraph); /* the topology only needs duplication the first time it is stored in the frd file (*kode=1) the above two lines are not true: lakon is needed for contact information in frd.f */ // if(*kode==1){ NNEW(kont,ITG,*nkon*ngraph); NNEW(ipkont,ITG,*ne*ngraph); NNEW(lakont,char,8**ne*ngraph); NNEW(ielmatt,ITG,mi[2]**ne*ngraph); // } NNEW(inumt,ITG,*nk*ngraph); nkt=ngraph**nk; net0=(ngraph-1)**ne+(*ne0); net=ngraph**ne; /* copying the coordinates of the first sector */ for(l=0;l<3**nk;l++){cot[l]=co[l];} if(*ntrans>0){for(l=0;l<*nk;l++){inotrt[2*l]=inotr[2*l];}} /* copying the topology of the first sector */ // if(*kode==1){ for(l=0;l<*nkon;l++){kont[l]=kon[l];} for(l=0;l<*ne;l++){ipkont[l]=ipkon[l];} for(l=0;l<8**ne;l++){lakont[l]=lakon[l];} for(l=0;l<mi[2]**ne;l++){ielmatt[l]=ielmat[l];} // } /* generating the coordinates for the other sectors */ icntrl=1; FORTRAN(rectcyl,(cot,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn)); for(jj=0;jj<*mcs;jj++){ is=cs[17*jj+4]; for(i=1;i<is;i++){ theta=i*2.*pi/cs[17*jj]; for(l=0;l<*nk;l++){ if(inocs[l]==jj){ cot[3*l+i*3**nk]=cot[3*l]; cot[1+3*l+i*3**nk]=cot[1+3*l]+theta; cot[2+3*l+i*3**nk]=cot[2+3*l]; } } if(*ntrans>0){ for(l=0;l<*nk;l++){ if(inocs[l]==jj){ inotrt[2*l+i*2**nk]=inotrt[2*l]; } } } // if(*kode==1){ for(l=0;l<*nkon;l++){kont[l+i**nkon]=kon[l]+i**nk;} for(l=0;l<*ne;l++){ if(ielcs[l]==jj){ if(ipkon[l]>=0){ ipkont[l+i**ne]=ipkon[l]+i**nkon; ielmatt[mi[2]*(l+i**ne)]=ielmat[mi[2]*l]; for(l1=0;l1<8;l1++){ l2=8*l+l1; lakont[l2+i*8**ne]=lakon[l2]; } } else ipkont[l+i**ne]=-1; } } // } } } icntrl=-1; FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab, &imag,mi,emn)); /* mapping the results to the other sectors */ for(l=0;l<*nk;l++){inumt[l]=inum[l];} icntrl=2; FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn)); if((strcmp1(&filab[0],"U ")==0)|| ((strcmp1(&filab[87],"NT ")==0)&&(*ithermal>=2))) for(l=0;l<mt**nk;l++){vt[l]=v[l];}; if((strcmp1(&filab[87],"NT ")==0)&&(*ithermal<2)) for(l=0;l<*nk;l++){t1t[l]=t1[l];}; if(strcmp1(&filab[174],"S ")==0) for(l=0;l<6**nk;l++){stnt[l]=stn[l];}; if(strcmp1(&filab[261],"E ")==0) for(l=0;l<6**nk;l++){eent[l]=een[l];}; if((strcmp1(&filab[348],"RF ")==0)||(strcmp1(&filab[783],"RFL ")==0)) for(l=0;l<mt**nk;l++){fnt[l]=fn[l];}; if(strcmp1(&filab[435],"PEEQ")==0) for(l=0;l<*nk;l++){epnt[l]=epn[l];}; if(strcmp1(&filab[522],"ENER")==0) for(l=0;l<*nk;l++){enernt[l]=enern[l];}; if(strcmp1(&filab[609],"SDV ")==0) for(l=0;l<*nstate_**nk;l++){xstatent[l]=xstaten[l];}; if(strcmp1(&filab[696],"HFL ")==0) for(l=0;l<3**nk;l++){qfnt[l]=qfn[l];}; if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)|| (strcmp1(&filab[2175],"CONT")==0)) for(l=0;l<6*mi[0]**ne;l++){stit[l]=sti[l];}; if(strcmp1(&filab[2697],"ME ")==0) for(l=0;l<6**nk;l++){emnt[l]=emn[l];}; for(jj=0;jj<*mcs;jj++){ is=cs[17*jj+4]; for(i=1;i<is;i++){ for(l=0;l<*nk;l++){inumt[l+i**nk]=inum[l];} if((strcmp1(&filab[0],"U ")==0)|| ((strcmp1(&filab[87],"NT ")==0)&&(*ithermal>=2))){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<4;l2++){ l=mt*l1+l2; vt[l+mt**nk*i]=v[l]; } } } } if((strcmp1(&filab[87],"NT ")==0)&&(*ithermal<2)){ for(l=0;l<*nk;l++){ if(inocs[l]==jj) t1t[l+*nk*i]=t1[l]; } } if(strcmp1(&filab[174],"S ")==0){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<6;l2++){ l=6*l1+l2; stnt[l+6**nk*i]=stn[l]; } } } } if(strcmp1(&filab[261],"E ")==0){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<6;l2++){ l=6*l1+l2; eent[l+6**nk*i]=een[l]; } } } } if((strcmp1(&filab[348],"RF ")==0)||(strcmp1(&filab[783],"RFL ")==0)){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<4;l2++){ l=mt*l1+l2; fnt[l+mt**nk*i]=fn[l]; } } } } if(strcmp1(&filab[435],"PEEQ")==0){ for(l=0;l<*nk;l++){ if(inocs[l]==jj) epnt[l+*nk*i]=epn[l]; } } if(strcmp1(&filab[522],"ENER")==0){ for(l=0;l<*nk;l++){ if(inocs[l]==jj) enernt[l+*nk*i]=enern[l]; } } if(strcmp1(&filab[609],"SDV ")==0){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<*nstate_;l2++){ l=*nstate_*l1+l2; xstatent[l+*nstate_**nk*i]=xstaten[l]; } } } } if(strcmp1(&filab[696],"HFL ")==0){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<3;l2++){ l=3*l1+l2; qfnt[l+3**nk*i]=qfn[l]; } } } } if(strcmp1(&filab[2697],"ME ")==0){ for(l1=0;l1<*nk;l1++){ if(inocs[l1]==jj){ for(l2=0;l2<6;l2++){ l=6*l1+l2; emnt[l+6**nk*i]=emn[l]; } } } } } } icntrl=-2; FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab, &imag,mi,emn)); if(strcmp1(&filab[1044],"ZZS")==0){ NNEW(neigh,ITG,40*net); NNEW(ipneigh,ITG,nkt); } frd(cot,&nkt,kont,ipkont,lakont,&net0,vt,stnt,inumt,nmethod, kode,filab,eent,t1t,fnt,time,epnt,ielmatt,matname,enernt,xstatent, nstate_,istep,iinc,ithermal,qfnt,&mode,noddiam,trab,inotrt, ntrans,orab,ielorien,norien,description,ipneigh,neigh, mi,stit,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,&net, cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emnt, thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat); if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);} if((strcmp1(&filab[0],"U ")==0)|| ((strcmp1(&filab[87],"NT ")==0)&&(*ithermal>=2))) SFREE(vt); if((strcmp1(&filab[87],"NT ")==0)&&(*ithermal<2)) SFREE(t1t); if((strcmp1(&filab[174],"S ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)|| (strcmp1(&filab[1044],"ERR ")==0)) SFREE(stnt); if(strcmp1(&filab[261],"E ")==0) SFREE(eent); if((strcmp1(&filab[348],"RF ")==0)||(strcmp1(&filab[783],"RFL ")==0)) SFREE(fnt); if(strcmp1(&filab[435],"PEEQ")==0) SFREE(epnt); if(strcmp1(&filab[522],"ENER")==0) SFREE(enernt); if(strcmp1(&filab[609],"SDV ")==0) SFREE(xstatent); if(strcmp1(&filab[696],"HFL ")==0) SFREE(qfnt); if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)|| (strcmp1(&filab[2175],"CONT")==0)) SFREE(stit); if(strcmp1(&filab[2697],"ME ")==0) SFREE(emnt); SFREE(kont);SFREE(ipkont);SFREE(lakont);SFREE(ielmatt); SFREE(inumt);SFREE(cot);if(*ntrans>0)SFREE(inotrt); SFREE(inocs);SFREE(ielcs); return; }
void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne, ITG *nodeboun, ITG *ndirboun, double *xboun, ITG *nboun, ITG *ipompc, ITG *nodempc, double *coefmpc, char *labmpc, ITG *nmpc, ITG *nodeforc, ITG *ndirforc,double *xforc, ITG *nforc, ITG *nelemload, char *sideload, double *xload, ITG *nload, ITG *nactdof, ITG *icol, ITG *jq, ITG *irow, ITG *neq, ITG *nzl, ITG *nmethod, ITG *ikmpc, ITG *ilmpc, ITG *ikboun, ITG *ilboun, double *elcon, ITG *nelcon, double *rhcon, ITG *nrhcon, double *alcon, ITG *nalcon, double *alzero, ITG *ielmat, ITG *ielorien, ITG *norien, double *orab, ITG *ntmat_, double *t0, double *t1, double *t1old, ITG *ithermal,double *prestr, ITG *iprestr, double *vold,ITG *iperturb, double *sti, ITG *nzs, ITG *kode, ITG *mei, double *fei, char *filab, double *eme, ITG *iexpl, double *plicon, ITG *nplicon, double *plkcon, ITG *nplkcon, double *xstate, ITG *npmat_, char *matname, ITG *mi, ITG *ncmat_, ITG *nstate_, double *ener, char *output, char *set, ITG *nset, ITG *istartset, ITG *iendset, ITG *ialset, ITG *nprint, char *prlab, char *prset, ITG *nener, ITG *isolver, double *trab, ITG *inotr, ITG *ntrans, double *ttime,double *fmpc, char *cbody, ITG *ibody,double *xbody, ITG *nbody, double *thicke,char *jobnamec,ITG *nmat,ITG *ielprop, double *prop){ char bmat[2]="G", which[3]="LM", howmny[2]="A", description[13]=" ",*tieset=NULL; ITG *inum=NULL,k,ido,dz,iparam[11],ipntr[11],lworkl,im,nasym=0, info,rvec=1,*select=NULL,lfin,j,lint,iout,iconverged=0,ielas,icmd=0, iinc=1,istep=1,*ncocon=NULL,*nshcon=NULL,nev,ncv,mxiter,jrow, *ipobody=NULL,inewton=0,coriolis=0,ifreebody,symmetryflag=0, inputformat=0,ngraph=1,mt=mi[1]+1,mass[2]={0,0}, stiffness=1, buckling=0, rhsi=1, intscheme=0, noddiam=-1,*ipneigh=NULL,*neigh=NULL,ne0, *integerglob=NULL,ntie,icfd=0,*inomat=NULL,mortar=0,*islavnode=NULL, *islavact=NULL,*nslavnode=NULL,*islavsurf=NULL; double *stn=NULL,*v=NULL,*resid=NULL,*z=NULL,*workd=NULL, *workl=NULL,*d=NULL,sigma,*temp_array=NULL, *een=NULL,cam[5],*f=NULL,*fn=NULL,qa[3],*fext=NULL, time=0.,*epn=NULL,*fnr=NULL,*fni=NULL,*emn=NULL,*cdn=NULL, *xstateini=NULL,*xstiff=NULL,*stiini=NULL,*vini=NULL,*stx=NULL, *enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,*cocon=NULL, *shcon=NULL,*physcon=NULL,*qfx=NULL,*qfn=NULL,tol, *cgr=NULL, *xloadold=NULL,reltime,*vr=NULL,*vi=NULL,*stnr=NULL,*stni=NULL, *vmax=NULL,*stnmax=NULL,*cs=NULL,*springarea=NULL,*eenmax=NULL, *emeini=NULL,*doubleglob=NULL,*au=NULL,*clearini=NULL, *ad=NULL,*b=NULL,*aub=NULL,*adb=NULL,*pslavsurf=NULL,*pmastsurf=NULL, *cdnr=NULL,*cdni=NULL; /* buckling routine; only for mechanical applications */ /* dummy arguments for the results call */ double *veold=NULL,*accold=NULL,bet,gam,dtime; #ifdef SGI ITG token; #endif /* copying the frequency parameters */ nev=mei[0]; ncv=mei[1]; mxiter=mei[2]; tol=fei[0]; /* calculating the stresses due to the buckling load; this is a second order calculation if iperturb != 0 */ *nmethod=1; /* assigning the body forces to the elements */ if(*nbody>0){ ifreebody=*ne+1; NNEW(ipobody,ITG,2*ifreebody**nbody); for(k=1;k<=*nbody;k++){ FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset, iendset,ialset,&inewton,nset,&ifreebody,&k)); RENEW(ipobody,ITG,2*(*ne+ifreebody)); } RENEW(ipobody,ITG,2*(ifreebody-1)); } /* determining the internal forces and the stiffness coefficients */ NNEW(f,double,neq[0]); /* allocating a field for the stiffness matrix */ NNEW(xstiff,double,(long long)27*mi[0]**ne); // iout=-1; NNEW(v,double,mt**nk); NNEW(fn,double,mt**nk); NNEW(stx,double,6*mi[0]**ne); iout=-1; NNEW(inum,ITG,*nk); if(*iperturb==0){ results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx, elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat, ielorien,norien,orab,ntmat_,t0,t0,ithermal, prestr,iprestr,filab,eme,emn,een,iperturb, f,fn,nactdof,&iout,qa,vold,b,nodeboun, ndirboun,xboun,nboun,ipompc, nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[0],veold,accold, &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon, xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas, &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern, emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset, iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans, fmpc,nelemload,nload,ikmpc,ilmpc,&istep,&iinc,springarea, &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon, sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf, &mortar,islavact,cdn,islavnode,nslavnode,&ntie,clearini, islavsurf,ielprop,prop); }else{ results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx, elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat, ielorien,norien,orab,ntmat_,t0,t1old,ithermal, prestr,iprestr,filab,eme,emn,een,iperturb, f,fn,nactdof,&iout,qa,vold,b,nodeboun, ndirboun,xboun,nboun,ipompc, nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[0],veold,accold, &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon, xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas, &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern, emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset, iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans, fmpc,nelemload,nload,ikmpc,ilmpc,&istep,&iinc,springarea, &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon, sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf, &mortar,islavact,cdn,islavnode,nslavnode,&ntie,clearini, islavsurf,ielprop,prop); } SFREE(v);SFREE(fn);SFREE(stx);SFREE(inum); iout=1; /* determining the system matrix and the external forces */ NNEW(ad,double,neq[0]); NNEW(au,double,nzs[0]); NNEW(fext,double,neq[0]); if(*iperturb==0){ FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun, ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc, nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr, ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod, ikmpc,ilmpc,ikboun,ilboun, elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat, ielorien,norien,orab,ntmat_, t0,t0,ithermal,prestr,iprestr,vold,iperturb,sti, &nzs[0],stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon, xstiff,npmat_,&dtime,matname,mi, ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,physcon, shcon,nshcon,cocon,ncocon,ttime,&time,&istep,&iinc,&coriolis, ibody,xloadold,&reltime,veold,springarea,nstate_, xstateini,xstate,thicke,integerglob,doubleglob, tieset,istartset,iendset,ialset,&ntie,&nasym,pslavsurf,pmastsurf, &mortar,clearini,ielprop,prop)); } else{ FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun, ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc, nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr, ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod, ikmpc,ilmpc,ikboun,ilboun, elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat, ielorien,norien,orab,ntmat_, t0,t1old,ithermal,prestr,iprestr,vold,iperturb,sti, &nzs[0],stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon, xstiff,npmat_,&dtime,matname,mi, ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,physcon, shcon,nshcon,cocon,ncocon,ttime,&time,&istep,&iinc,&coriolis, ibody,xloadold,&reltime,veold,springarea,nstate_, xstateini,xstate,thicke,integerglob,doubleglob, tieset,istartset,iendset,ialset,&ntie,&nasym,pslavsurf, pmastsurf,&mortar,clearini,ielprop,prop)); } /* determining the right hand side */ NNEW(b,double,neq[0]); for(k=0;k<neq[0];++k){ b[k]=fext[k]-f[k]; } SFREE(fext);SFREE(f); if(*nmethod==0){ /* error occurred in mafill: storing the geometry in frd format */ ++*kode; NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1; if(strcmp1(&filab[1044],"ZZS")==0){ NNEW(neigh,ITG,40**ne); NNEW(ipneigh,ITG,*nk); } frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod, kode,filab,een,t1,fn,&time,epn,ielmat,matname,enern,xstaten, nstate_,&istep,&iinc,ithermal,qfn,&j,&noddiam,trab,inotr, ntrans,orab,ielorien,norien,description,ipneigh,neigh, mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne, cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn, thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat); if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);} SFREE(inum);FORTRAN(stop,()); }
void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne, double *stn, ITG *nmethod, ITG *kode, char *filab, double *een, double *t1act, double *time, double *epn,ITG *ielmat,char *matname, double *enern, double *xstaten, ITG *nstate_, ITG *istep, ITG *iinc, ITG *iperturb, double *ener, ITG *mi, char *output, ITG *ithermal, double *qfn, ITG *mode, ITG *noddiam, double *trab, ITG *inotr, ITG *ntrans, double *orab, ITG *ielorien, ITG *norien, char *description,double *sti, ITG *icutb, ITG *iit, double *dtime, double *qa, double *vold, double *qam, double *ram1, double *ram2, double *ram, double *cam, double *uam, ITG *ntg, double *ttime, ITG *icntrl, double *theta, double *dtheta, double *veold, double *vini, ITG *idrct, double *tper,ITG *istab, double *tmax, ITG *nactdof, double *b, double *tmin, double *ctrl, double *amta, ITG *namta, ITG *itpamp, ITG *inext, double *dthetaref, ITG *itp, ITG *jprint, ITG *jout, ITG *uncoupled, double *t1, ITG *iitterm, ITG *nelemload, ITG *nload, ITG *nodeboun, ITG *nboun, ITG *itg, ITG *ndirboun, double *deltmx, ITG *iflagact,char *set,ITG *nset, ITG *istartset,ITG *iendset,ITG *ialset, double *emn, double *thicke, char *jobnamec,ITG *mortar){ ITG i0,ir,ip,ic,il,ig,ia,iest,iest1=0,iest2=0,iconvergence,idivergence, ngraph=1,k,*ipneigh=NULL,*neigh=NULL,*inum=NULL,id,istart,iend,inew, i,j,mt=mi[1]+1,iexceed; double df,dc,db,dd,ran,can,rap,ea,cae,ral,da,*vr=NULL,*vi=NULL,*stnr=NULL, *stni=NULL,*vmax=NULL,*stnmax=NULL,*cs=NULL,c1[2],c2[2],reftime, *fn=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,*qfx=NULL,*cdn=NULL, *cdnr=NULL,*cdni=NULL; /* next lines are active if the number of contact elements was changed in the present increment */ if ((*iflagact==1)&&(*mortar==0)){ if(ctrl[0]<*iit+4)ctrl[0]=*iit+4; if(ctrl[1]<*iit+8)ctrl[1]=*iit+8; ctrl[3]+=1; } i0=ctrl[0];ir=ctrl[1];ip=ctrl[2];ic=ctrl[3];il=ctrl[4];ig=ctrl[5]; ia=ctrl[7];df=ctrl[10];dc=ctrl[11];db=ctrl[12];da=ctrl[13];dd=ctrl[16]; ran=ctrl[18];can=ctrl[19];rap=ctrl[22]; ea=ctrl[23];cae=ctrl[24];ral=ctrl[25]; /* check for forced divergence (due to divergence of a user material routine */ if(qa[2]>0.){idivergence=1;}else{idivergence=0;} if(*ithermal!=2){ if(qa[0]>ea*qam[0]){ if(*iit<=ip){c1[0]=ran;} else{c1[0]=rap;} c2[0]=can; } else{ c1[0]=ea; c2[0]=cae; } if(ram1[0]<ram2[0]){ram2[0]=ram1[0];} } if(*ithermal>1){ if(qa[1]>ea*qam[1]){ if(*iit<=ip){c1[1]=ran;} else{c1[1]=rap;} c2[1]=can; } else{ c1[1]=ea; c2[1]=cae; } if(ram1[1]<ram2[1]){ram2[1]=ram1[1];} } iconvergence=0; /* mechanical */ if(*ithermal<2){ if((*iit>1)&&(ram[0]<=c1[0]*qam[0])&&(*iflagact==0)&& // if((*iit>1)&&(ram[0]<=c1[0]*qam[0])&& ((cam[0]<=c2[0]*uam[0])|| (((ram[0]*cam[0]<c2[0]*uam[0]*ram2[0])||(ram[0]<=ral*qam[0])|| (qa[0]<=ea*qam[0]))&&(*ntg==0))|| (cam[0]<1.e-8))) iconvergence=1; } /* thermal */ if(*ithermal==2){ if((ram[1]<=c1[1]*qam[1])&& (cam[2]<*deltmx)&& ((cam[1]<=c2[1]*uam[1])|| (((ram[1]*cam[1]<c2[1]*uam[1]*ram2[1])||(ram[1]<=ral*qam[1])|| (qa[1]<=ea*qam[1]))&&(*ntg==0))|| (cam[1]<1.e-8)))iconvergence=1; } /* thermomechanical */ if(*ithermal==3){ if(((ram[0]<=c1[0]*qam[0])&& ((cam[0]<=c2[0]*uam[0])|| (((ram[0]*cam[0]<c2[0]*uam[0]*ram2[0])||(ram[0]<=ral*qam[0])|| (qa[0]<=ea*qam[0]))&&(*ntg==0))|| (cam[0]<1.e-8)))&& ((ram[1]<=c1[1]*qam[1])&& (cam[2]<*deltmx)&& ((cam[1]<=c2[1]*uam[1])|| (((ram[1]*cam[1]<c2[1]*uam[1]*ram2[1])||(ram[1]<=ral*qam[1])|| (qa[1]<=ea*qam[1]))&&(*ntg==0))|| (cam[1]<1.e-8))))iconvergence=1; } /* reset iflagact */ *iflagact=0; /* increment convergence reached */ if((iconvergence==1)&&(idivergence==0)){ // *ttime=*ttime+*dtime; /* cutting the insignificant digits from ttime */ // *ttime=*ttime+1.; // *ttime=*ttime-1.; FORTRAN(writesummary,(istep,iinc,icutb,iit,ttime,time,dtime)); if(*uncoupled){ if(*ithermal==2){ *iitterm=*iit; *ithermal=1; for(k=0;k<*nk;++k){t1[k]=vold[mt*k];} // *ttime=*ttime-*dtime; *iit=1; (ctrl[0])*=4; printf(" thermal convergence\n\n"); return; }else{ *ithermal=3; *iit=*iitterm; (ctrl[0])/=4; } } *icntrl=1; *icutb=0; *theta=*theta+*dtheta; /* defining a mean "velocity" for static calculations: is used to extrapolate the present results for next increment */ if(*nmethod != 4){ for(i=0;i<*nk;i++){ for(j=1;j<mt;j++){ veold[mt*i+j]=(vold[mt*i+j]-vini[mt*i+j])/(*dtime); } } } /* check whether next increment size must be decreased */ if((*iit>il)&&(*idrct==0)){ if(*mortar==0){ *dtheta=*dthetaref*db; *dthetaref=*dtheta; printf(" convergence; the increment size is decreased to %e\n\n",*dtheta**tper); if(*dtheta<*tmin){ printf("\n *ERROR: increment size smaller than minimum\n"); printf(" best solution and residuals are in the frd file\n\n"); fn=NNEW(double,mt**nk); inum=NNEW(ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1; FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal, nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab, ielorien,co,itg,ntg,vold,ielmat,thicke)); ++*kode; (*ttime)+=(*time); frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod, kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern, xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam, trab,inotr,ntrans,orab,ielorien,norien,description, ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax, &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset, ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx, cdn,mortar,cdnr,cdni); FORTRAN(uout,(vold,mi,ithermal)); FORTRAN(stop,()); } }