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,());
}
}
