//-----------------------------------------------------------------
//! \brief Create a popup item
//-----------------------------------------------------------------
NMenuCtrl* NMenuCtrl::CreatePopupMenu(const char* _pszName, udword _idx)
{
NMenuCtrl* ppopup =NNEW(NMenuCtrl);
if (_idx<m_carrayItems.Count())
{
m_carrayItems[_idx].ppopUpMenu = ppopup;
m_carrayItems[_idx].ppopUpMenu->Create("", this);
m_carrayItems[_idx].strName = _pszName;
//Append
} else {
NMEItemDesc st;
st.dwID = m_carrayItems.Count()+1;
st.dwUserData = 0;
st.strName = _pszName;
st.bEnabled = true;
st.bChecked = false;
st.dwStyle = 0;
st.ppopUpMenu = ppopup;
m_carrayItems.AddItem(st);
st.ppopUpMenu->Create("", this);
}
return ppopup;
}
//-----------------------------------------------------------------
//! \brief Init Application
//! \return True if success
//-----------------------------------------------------------------
bool NFxGenApp::Init()
{
// Create main window
m_appWnd.Create(sf::VideoMode(WIDTH, HEIGHT), CAPTION);
// GUI SubSystem
NGUISubSystem* pgui = GetGUISubSystem();
pgui->Init();
//Create Main Frame Window
NMainFrm* frame = NNEW( NMainFrm );
pgui->SetMainWnd(frame);
frame->Create(CAPTION, NRect(0,0,WIDTH,HEIGHT)); //###TOFIX### not reel client size (see wnd caption...)
return true;
}
void resultsinduction(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *ne,
double *v,double *stn,ITG *inum,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,ITG *ithermal,double *prestr,ITG *iprestr,char *filab,
double *eme,double *emn,
double *een,ITG *iperturb,double *f,double *fn,ITG *nactdof,ITG *iout,
double *qa,double *vold,double *b,ITG *nodeboun,ITG *ndirboun,
double *xboun,ITG *nboun,ITG *ipompc,ITG *nodempc,double *coefmpc,
char *labmpc,ITG *nmpc,ITG *nmethod,double *cam,ITG *neq,double *veold,
double *accold,double *bet,double *gam,double *dtime,double *time,
double *ttime,double *plicon,ITG *nplicon,double *plkcon,
ITG *nplkcon,double *xstateini,double *xstiff,double *xstate,ITG *npmat_,
double *epn,char *matname,ITG *mi,ITG *ielas,ITG *icmd,ITG *ncmat_,
ITG *nstate_,
double *sti,double *vini,ITG *ikboun,ITG *ilboun,double *ener,
double *enern,double *emeini,double *xstaten,double *eei,double *enerini,
double *cocon,ITG *ncocon,char *set,ITG *nset,ITG *istartset,
ITG *iendset,
ITG *ialset,ITG *nprint,char *prlab,char *prset,double *qfx,double *qfn,
double *trab,
ITG *inotr,ITG *ntrans,double *fmpc,ITG *nelemload,ITG *nload,
ITG *ikmpc,ITG *ilmpc,
ITG *istep,ITG *iinc,double *springarea,double *reltime, ITG *ne0,
double *xforc, ITG *nforc, double *thicke,
double *shcon,ITG *nshcon,char *sideload,double *xload,
double *xloadold,ITG *icfd,ITG *inomat,double *h0,ITG *islavnode,
ITG *nslavnode,ITG *ntie){
/* variables for multithreading procedure */
char *env,*envloc,*envsys;
ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,iener,ikin,
intpointvart,mt=mi[1]+1,i,j,*ithread=NULL,*islavsurf=NULL,
sys_cpus,mortar=0,*islavact=NULL;
double *pmastsurf=NULL,*clearini=NULL,*pslavsurf=NULL,*cdn=NULL;
/*
calculating integration point values (strains, stresses,
heat fluxes, material tangent matrices and nodal forces)
storing the nodal and integration point results in the
.dat file
iout=-2: v is assumed to be known and is used to
calculate strains, stresses..., no result output
corresponds to iout=-1 with in addition the
calculation of the internal energy density
iout=-1: v is assumed to be known and is used to
calculate strains, stresses..., no result output;
is used to take changes in SPC's and MPC's at the
start of a new increment or iteration into account
iout=0: v is calculated from the system solution
and strains, stresses.. are calculated, no result output
iout=1: v is calculated from the system solution and strains,
stresses.. are calculated, requested results output
iout=2: v is assumed to be known and is used to
calculate strains, stresses..., requested results output */
num_cpus=0;
sys_cpus=0;
/* explicit user declaration prevails */
envsys=getenv("NUMBER_OF_CPUS");
if(envsys){
sys_cpus=atoi(envsys);
if(sys_cpus<0) sys_cpus=0;
}
/* automatic detection of available number of processors */
if(sys_cpus==0){
sys_cpus = getSystemCPUs();
if(sys_cpus<1) sys_cpus=1;
}
/* local declaration prevails, if strictly positive */
envloc = getenv("CCX_NPROC_RESULTS");
if(envloc){
num_cpus=atoi(envloc);
if(num_cpus<0){
num_cpus=0;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
/* else global declaration, if any, applies */
env = getenv("OMP_NUM_THREADS");
if(num_cpus==0){
if (env)
num_cpus = atoi(env);
if (num_cpus < 1) {
num_cpus=1;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
// next line is to be inserted in a similar way for all other paralell parts
if(*ne<num_cpus) num_cpus=*ne;
pthread_t tid[num_cpus];
/* 1. nodewise storage of the primary variables
2. determination which derived variables have to be calculated */
FORTRAN(resultsini_em,(nk,v,ithermal,filab,iperturb,f,fn,
nactdof,iout,qa,vold,b,nodeboun,ndirboun,
xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,
veold,dtime,mi,vini,nprint,prlab,
&intpointvarm,&calcul_fn,&calcul_f,&calcul_qa,&calcul_cauchy,&iener,
&ikin,&intpointvart,xforc,nforc));
/* electromagnetic calculation is linear: should not be taken
into account in the convergence check (only thermal part
is taken into account) */
cam[0]=0.;
/* next statement allows for storing the displacements in each
iteration: for debugging purposes */
if((strcmp1(&filab[3],"I")==0)&&(*iout==0)){
FORTRAN(frditeration,(co,nk,kon,ipkon,lakon,ne,v,
ttime,ielmat,matname,mi,istep,iinc,ithermal));
}
/* calculating the stresses and material tangent at the
integration points; calculating the internal forces */
if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;elcon1=elcon;
nelcon1=nelcon;ielmat1=ielmat;ntmat1_=ntmat_;vold1=vold;dtime1=dtime;
matname1=matname;mi1=mi;ncmat1_=ncmat_;sti1=sti;alcon1=alcon;
nalcon1=nalcon;h01=h0;ne1=ne;
/* calculating the magnetic field */
if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
printf(" Using up to %" ITGFORMAT " cpu(s) for the magnetic field calculation.\n\n", num_cpus);
}
/* create threads and wait */
ithread=NNEW(ITG,num_cpus);
for(i=0; i<num_cpus; i++) {
ithread[i]=i;
pthread_create(&tid[i], NULL, (void *)resultsemmt, (void *)&ithread[i]);
}
for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
free(ithread);
qa[0]=0.;
}
/* calculating the thermal flux and material tangent at the
integration points; calculating the internal point flux */
if((ithermal[0]>=2)&&(intpointvart==1)){
fn1=NNEW(double,num_cpus*mt**nk);
qa1=NNEW(double,num_cpus*3);
nal=NNEW(ITG,num_cpus);
co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;
elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;nrhcon1=nrhcon;
ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
ntmat1_=ntmat_;t01=t0;iperturb1=iperturb;iout1=iout;vold1=vold;
ipompc1=ipompc;nodempc1=nodempc;coefmpc1=coefmpc;nmpc1=nmpc;
dtime1=dtime;time1=time;ttime1=ttime;plkcon1=plkcon;
nplkcon1=nplkcon;xstateini1=xstateini;xstiff1=xstiff;
xstate1=xstate;npmat1_=npmat_;matname1=matname;mi1=mi;
ncmat1_=ncmat_;nstate1_=nstate_;cocon1=cocon;ncocon1=ncocon;
qfx1=qfx;ikmpc1=ikmpc;ilmpc1=ilmpc;istep1=istep;iinc1=iinc;
springarea1=springarea;calcul_fn1=calcul_fn;calcul_qa1=calcul_qa;
mt1=mt;nk1=nk;shcon1=shcon;nshcon1=nshcon;ithermal1=ithermal;
nelemload1=nelemload;nload1=nload;nmethod1=nmethod;reltime1=reltime;
sideload1=sideload;xload1=xload;xloadold1=xloadold;
pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
clearini1=clearini;plicon1=plicon;nplicon1=nplicon;
/* calculating the heat flux */
printf(" Using up to %" ITGFORMAT " cpu(s) for the heat flux calculation.\n\n", num_cpus);
/* create threads and wait */
ithread=NNEW(ITG,num_cpus);
for(i=0; i<num_cpus; i++) {
ithread[i]=i;
pthread_create(&tid[i], NULL, (void *)resultsthermemmt, (void *)&ithread[i]);
}
for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
for(i=0;i<*nk;i++){
fn[mt*i]=fn1[mt*i];
}
for(i=0;i<*nk;i++){
for(j=1;j<num_cpus;j++){
fn[mt*i]+=fn1[mt*i+j*mt**nk];
}
}
free(fn1);free(ithread);
/* determine the internal concentrated heat flux */
qa[1]=qa1[1];
for(j=1;j<num_cpus;j++){
qa[1]+=qa1[1+j*3];
}
free(qa1);
for(j=1;j<num_cpus;j++){
nal[0]+=nal[j];
}
if(calcul_qa==1){
if(nal[0]>0){
qa[1]/=nal[0];
}
}
free(nal);
}
void contact(ITG *ncont, ITG *ntie, char *tieset,ITG *nset,char *set,
ITG *istartset, ITG *iendset, ITG *ialset,ITG *itietri,
char *lakon, ITG *ipkon, ITG *kon, ITG *koncont, ITG *ne,
double *cg, double *straight, ITG *ifree, double *co,
double *vold, ITG *ielmat, double *cs, double *elcon,
ITG *istep,ITG *iinc,ITG *iit,ITG *ncmat_,ITG *ntmat_,
ITG *ne0, double *vini,
ITG *nmethod, ITG *nmpc, ITG *mpcfree, ITG *memmpc_,
ITG **ipompcp, char **labmpcp, ITG **ikmpcp, ITG **ilmpcp,
double **fmpcp, ITG **nodempcp, double **coefmpcp,
ITG *iperturb, ITG *ikboun, ITG *nboun, ITG *mi,
ITG *imastop,ITG *nslavnode,ITG *islavnode,ITG *islavsurf,
ITG *itiefac,double *areaslav,ITG *iponoels,ITG *inoels,
double *springarea, double *tietol, double *reltime,
ITG *imastnode, ITG *nmastnode, double *xmastnor,
char *filab, ITG *mcs, ITG *ics,
ITG *nasym,double *xnoels,ITG *mortar,double *pslavsurf,
double *pmastsurf,double *clearini,double *theta){
char *labmpc=NULL;
ITG i,ntrimax,*nx=NULL,*ny=NULL,*nz=NULL,*ipompc=NULL,*ikmpc=NULL,
*ilmpc=NULL,*nodempc=NULL,nmpc_,im;
double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL,
*fmpc=NULL, *coefmpc=NULL;
ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;
nmpc_=*nmpc;
/* next call is only for node-to-face penalty contact
setting up bordering planes for the master triangles;
these planes are common between neighboring traingles */
if(*mortar==0){
DMEMSET(xmastnor,0,3*nmastnode[*ntie],0.);
FORTRAN(updatecontpen,(koncont,ncont,co,vold,
cg,straight,mi,imastnode,nmastnode,xmastnor,
ntie,tieset,nset,set,istartset,
iendset,ialset,ipkon,lakon,kon,cs,mcs,ics));
}
/* determining the size of the auxiliary fields */
ntrimax=0;
for(i=0;i<*ntie;i++){
if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)
ntrimax=itietri[2*i+1]-itietri[2*i]+1;
}
xo=NNEW(double,ntrimax);
yo=NNEW(double,ntrimax);
zo=NNEW(double,ntrimax);
x=NNEW(double,ntrimax);
y=NNEW(double,ntrimax);
z=NNEW(double,ntrimax);
nx=NNEW(ITG,ntrimax);
ny=NNEW(ITG,ntrimax);
nz=NNEW(ITG,ntrimax);
if(*mortar==0){
FORTRAN(gencontelem_n2f,(tieset,ntie,itietri,ne,ipkon,kon,lakon,
cg,straight,ifree,koncont,
co,vold,xo,yo,zo,x,y,z,nx,ny,nz,ielmat,elcon,istep,
iinc,iit,ncmat_,ntmat_,nmethod,mi,
imastop,nslavnode,islavnode,islavsurf,itiefac,areaslav,iponoels,
inoels,springarea,
set,nset,istartset,iendset,ialset,tietol,reltime,
imastnode,nmastnode,filab,nasym,xnoels));
}else if(*mortar==1){
FORTRAN(gencontelem_f2f,(tieset,ntie,itietri,ne,ipkon,kon,
lakon,cg,straight,ifree,koncont,co,vold,xo,yo,zo,x,y,z,nx,ny,nz,
ielmat,elcon,istep,iinc,iit,ncmat_,ntmat_,mi,imastop,islavsurf,
itiefac,springarea,tietol,reltime,filab,nasym,pslavsurf,pmastsurf,
clearini,theta));
}
free(xo);free(yo);free(zo);free(x);free(y);free(z);free(nx);
free(ny);free(nz);
*ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
*fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;
return;
}
void remastructar(ITG *ipompc, double **coefmpcp, ITG **nodempcp, ITG *nmpc,
ITG *mpcfree, ITG *nodeboun, ITG *ndirboun, ITG *nboun,
ITG *ikmpc, ITG *ilmpc, ITG *ikboun, ITG *ilboun,
char *labmpc, ITG *nk,
ITG *memmpc_, ITG *icascade, ITG *maxlenmpc,
ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
ITG *nactdof, ITG *icol, ITG *jq, ITG **irowp, ITG *isolver,
ITG *neq, ITG *nzs,ITG *nmethod, ITG *ithermal,
ITG *iperturb, ITG *mass, ITG *mi, ITG *ics, double *cs,
ITG *mcs,ITG *mortar){
/* reconstructs the nonzero locations in the stiffness and mass
matrix after a change in MPC's or the generation of contact
spring elements: version for frequency calculations (called
by arpack and arpackcs) */
ITG *nodempc=NULL,*mast1=NULL,*ipointer=NULL,mpcend,mpcmult,
callfrommain,i,*irow=NULL,mt;
double *coefmpc=NULL;
nodempc=*nodempcp;coefmpc=*coefmpcp;irow=*irowp;
mt=mi[1]+1;
/* decascading the MPC's */
printf(" Decascading the MPC's\n\n");
callfrommain=0;
cascade(ipompc,&coefmpc,&nodempc,nmpc,
mpcfree,nodeboun,ndirboun,nboun,ikmpc,
ilmpc,ikboun,ilboun,&mpcend,&mpcmult,
labmpc,nk,memmpc_,icascade,maxlenmpc,
&callfrommain,iperturb,ithermal);
/* determining the matrix structure */
printf(" Determining the structure of the matrix:\n");
if(nzs[1]<10) nzs[1]=10;
mast1=NNEW(ITG,nzs[1]);
RENEW(irow,ITG,nzs[1]);for(i=0;i<nzs[1];i++) irow[i]=0;
if((*mcs==0)||(cs[1]<0)){
ipointer=NNEW(ITG,mt**nk);
mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
ikmpc,ilmpc,ipointer,nzs,nmethod,ithermal,
ikboun,ilboun,iperturb,mi,mortar);
}else{
ipointer=NNEW(ITG,8**nk);
mastructcs(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,
ipompc,nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,
neq,ikmpc,ilmpc,ipointer,nzs,nmethod,
ics,cs,labmpc,mcs,mi,mortar);
}
free(ipointer);free(mast1);
RENEW(irow,ITG,nzs[2]);
*nodempcp=nodempc;*coefmpcp=coefmpc;*irowp=irow;
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 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 readinput(char *jobnamec, char **inpcp, ITG *nline, ITG *nset,
ITG *ipoinp, ITG **inpp, ITG **ipoinpcp, ITG *ithermal){
/* reads and stores the input deck in inpcp; determines the
number of sets */
FILE *f1[10];
char buff[1320]="", fninp[132]="", includefn[132]="", *inpc=NULL,
textpart[2112]="",*set=NULL;
ITG i,j,k,n,in=0,nlinemax=100000,irestartread,irestartstep,
icntrl,nload,nforc,nboun,nk,ne,nmpc,nalset,nmat,ntmat,npmat,
norien,nam,nprint,mi[3],ntrans,ncs,namtot,ncmat,memmpc,ne1d,
ne2d,nflow,*meminset=NULL,*rmeminset=NULL, *inp=NULL,ntie,
nener,nstate,nentries=15,ifreeinp,ikey,lincludefn,nslavs,
nbody,ncharmax=1000000,*ipoinpc=NULL,ichangefriction=0,nkon,
ifile,mcs,initialtemperature=0,nprop,mortar,ifacecount,
nintpoint,infree[4],iheading=0,ichangesurfacebehavior=0;
/* initialization */
/* nentries is the number of different keyword cards for which
the input deck order is important, cf keystart.f */
NNEW(inpc,char,ncharmax);
NNEW(ipoinpc,ITG,nlinemax+1);
NNEW(inp,ITG,3*nlinemax);
*nline=0;
for(i=0;i<2*nentries;i++){ipoinp[i]=0;}
ifreeinp=1;
ikey=0;
/* opening the input file */
strcpy(fninp,jobnamec);
strcat(fninp,".inp");
if((f1[in]=fopen(fninp,"r"))==NULL){
printf("*ERROR in read: cannot open file %s\n",fninp);
exit(0);
}
/* starting to read the input file */
do{
if(fgets(buff,1320,f1[in])==NULL){
fclose(f1[in]);
if(in!=0){
in--;
continue;
}
else{break;}
}
/* check for heading lines: should not be changed */
if(iheading==1){
if((buff[0]=='*')&&(buff[1]!='*')){
iheading=0;
}
}
/* storing the significant characters */
/* get rid of blanks */
k=0;
i=-1;
if(iheading==0){
do{
i++;
if((buff[i]=='\0')||(buff[i]=='\n')||(buff[i]=='\r')||(k==1320)) break;
if((buff[i]==' ')||(buff[i]=='\t')) continue;
buff[k]=buff[i];
k++;
}while(1);
}else{
do{
i++;
if((buff[i]=='\0')||(buff[i]=='\n')||(buff[i]=='\r')||(k==1320)) break;
buff[k]=buff[i];
k++;
}while(1);
}
/* check for blank lines and comments */
if(k==0) continue;
if(strcmp1(&buff[0],"**")==0) continue;
/* changing to uppercase except filenames */
if(iheading==0){
j=0;
ifile=0;
do{
if(j>=6){
if(strcmp1(&buff[j-6],"INPUT=")==0) ifile=1;
}
if(j>=7){
if(strcmp1(&buff[j-7],"OUTPUT=")==0) ifile=1;
}
if(j>=9){
if(strcmp1(&buff[j-9],"FILENAME=")==0) ifile=1;
}
if(ifile==1){
do{
if(strcmp1(&buff[j],",")!=0){
j++;
}else{
ifile=0;
break;
}
}while(j<k);
}else{
buff[j]=toupper(buff[j]);
}
j++;
}while(j<k);
}
/* check for a *HEADING card */
if(strcmp1(&buff[0],"*HEADING")==0){
iheading=1;
}
/* check for include statements */
if(strcmp1(&buff[0],"*INCLUDE")==0){
lincludefn=k;
FORTRAN(includefilename,(buff,includefn,&lincludefn));
includefn[lincludefn]='\0';
in++;
if(in>9){
printf("*ERROR in read: include statements can \n not be cascaded over more than 9 levels\n");
}
if((f1[in]=fopen(includefn,"r"))==NULL){
printf("*ERROR in read: cannot open file %s\n",includefn);
exit(0);
}
continue;
}
/* adding a line */
(*nline)++;
if(*nline>nlinemax){
nlinemax=(ITG)(1.1*nlinemax);
RENEW(ipoinpc,ITG,nlinemax+1);
RENEW(inp,ITG,3*nlinemax);
}
/* checking the total number of characters */
if(ipoinpc[*nline-1]+k>ncharmax){
ncharmax=(ITG)(1.1*ncharmax);
RENEW(inpc,char,ncharmax);
}
/* copying into inpc */
for(j=0;j<k;j++){
inpc[ipoinpc[*nline-1]+j]=buff[j];
}
ipoinpc[*nline]=ipoinpc[*nline-1]+k;
/* counting sets */
if(strcmp1(&buff[0],"*AMPLITUDE")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"AMPLITUDE",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CHANGEFRICTION")==0){
ichangefriction=1;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CHANGESURFACEBEHAVIOR")==0){
ichangesurfacebehavior=1;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CONDUCTIVITY")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CONTACTDAMPING")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CONTACTPAIR")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"CONTACTPAIR",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CREEP")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*CYCLICHARDENING")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*DEFORMATIONPLASTICITY")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*DENSITY")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*DEPVAR")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*ELASTIC")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*ELECTRICALCONDUCTIVITY")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if((strcmp1(&buff[0],"*ELEMENT")==0)&&
(strcmp1(&buff[0],"*ELEMENTOUTPUT")!=0)){
(*nset)++;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ELEMENT",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*ELSET")==0){
(*nset)++;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ELSET",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*EXPANSION")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*FLUIDCONSTANTS")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if((strcmp1(&buff[0],"*FRICTION")==0)&&(ichangefriction==0)){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*GAPCONDUCTANCE")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*HYPERELASTIC")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*HYPERFOAM")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*INITIALCONDITIONS")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"INITIALCONDITIONS",
nline,&ikey));
FORTRAN(splitline,(buff,textpart,&n));
for(i=0;i<n;i++){
if(strcmp1(&textpart[(long long)132*i],"TYPE=TEMPERATURE")==0){
initialtemperature=1;
}
}
}
else if(strcmp1(&buff[0],"*MAGNETICPERMEABILITY")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*MATERIAL")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if((strcmp1(&buff[0],"*NODE")==0)&&
(strcmp1(&buff[0],"*NODEPRINT")!=0)&&
(strcmp1(&buff[0],"*NODEOUTPUT")!=0)&&
(strcmp1(&buff[0],"*NODEFILE")!=0)){
(*nset)++;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"NODE",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*NSET")==0){
(*nset)++;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"NSET",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*ORIENTATION")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ORIENTATION",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*PLASTIC")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*RESTART")==0){
irestartread=0;
irestartstep=0;
strcpy1(&buff[k]," ",1);
FORTRAN(splitline,(buff,textpart,&n));
for(i=0;i<n;i++){
if(strcmp1(&textpart[(long long)132*i],"READ")==0){
irestartread=1;
}
if(strcmp1(&textpart[(long long)132*i],"STEP")==0){
irestartstep=atoi(&textpart[(long long)132*i+5]);
}
}
if(irestartread==1){
icntrl=0;
FORTRAN(restartshort,(nset,&nload,&nbody,&nforc,&nboun,&nk,
&ne,&nmpc,&nalset,&nmat,&ntmat,&npmat,&norien,&nam,
&nprint,mi,&ntrans,&ncs,&namtot,&ncmat,&memmpc,
&ne1d,&ne2d,&nflow,set,meminset,rmeminset,jobnamec,
&irestartstep,&icntrl,ithermal,&nener,&nstate,&ntie,
&nslavs,&nkon,&mcs,&nprop,&mortar,&ifacecount,&nintpoint,
infree));
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"RESTART,READ",
nline,&ikey));
}
else{
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
}
}
else if(strcmp1(&buff[0],"*SPECIFICGASCONSTANT")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*SPECIFICHEAT")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*SUBMODEL")==0){
(*nset)+=2;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*SURFACEINTERACTION")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*SURFACEBEHAVIOR")==0){
if(ichangesurfacebehavior==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
nline,&ikey));
}else{
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
}
}
else if(strcmp1(&buff[0],"*SURFACE")==0){
(*nset)++;
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACE",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*TIE")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"TIE",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*TRANSFORM")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"TRANSFORM",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*USERMATERIAL")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
nline,&ikey));
}
else if(strcmp1(&buff[0],"*")==0){
FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
nline,&ikey));
/* checking whether the calculation is mechanical,
thermal or thermomechanical: needed to know
which mpc's to apply to 2-D elements */
if((strcmp1(&buff[0],"*STATIC")==0)||
(strcmp1(&buff[0],"*VISCO")==0)||
(strcmp1(&buff[0],"*DYNAMIC")==0)){
if(ithermal[1]==0){
if(initialtemperature==1)ithermal[1]=1;
}else if(ithermal[1]==2){
ithermal[1]=3;
}
}else if(strcmp1(&buff[0],"*HEATTRANSFER")==0){
if(ithermal[1]<2) ithermal[1]=ithermal[1]+2;
}else if(strcmp1(&buff[0],"*COUPLEDTEMPERATURE-DISPLACEMENT")==0){
ithermal[1]=3;
}else if(strcmp1(&buff[0],"*UNCOUPLEDTEMPERATURE-DISPLACEMENT")==0){
ithermal[1]=3;
}
}
}while(1);
inp[3*ipoinp[2*ikey-1]-2]=*nline;
RENEW(inpc,char,(long long)132**nline);
RENEW(inp,ITG,3*ipoinp[2*ikey-1]);
*inpcp=inpc;
*ipoinpcp=ipoinpc;
*inpp=inp;
// FORTRAN(writeinput,(inpc,ipoinp,inp,nline,&ipoinp[2*ikey-1],ipoinpc));
return;
}
//-----------------------------------------------------------------
// Constructor
//-----------------------------------------------------------------
NFxGenApp::NFxGenApp()
{
g_pceventsMgr = NNEW(NEventsMgr);
m_fOldTime = 0;
}
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,());
}
}
void pardiso_factor_as(double *ad, double *au, double *adb, double *aub,
double *sigma,ITG *icol, ITG *irow,
ITG *neq, ITG *nzs, ITG *jq){
char *env;
ITG i,j,k,maxfct=1,mnum=1,mtype=11,phase=12,nrhs=1,*perm=NULL,
msglvl=0,error=0,ifortran,lfortran,index,id;
long long ndim;
ITG nthread,nthread_v;
double *b=NULL,*x=NULL;
printf(" Factoring the system of equations using the asymmetric pardiso solver\n");
iparmas[0]=0;
/* set MKL_NUM_THREADS to min(CCX_NPROC_EQUATION_SOLVER,OMP_NUM_THREADS)
must be done once */
if (nthread_mkl_as == 0) {
nthread=1;
env=getenv("MKL_NUM_THREADS");
if(env) {
nthread=atoi(env);}
else {
env=getenv("OMP_NUM_THREADS");
if(env) {nthread=atoi(env);}
}
env=getenv("CCX_NPROC_EQUATION_SOLVER");
if(env) {
nthread_v=atoi(env);
if (nthread_v <= nthread) {nthread=nthread_v;}
}
if (nthread < 1) {nthread=1;}
sprintf(envMKL,"MKL_NUM_THREADS=%" ITGFORMAT "",nthread);
putenv(envMKL);
nthread_mkl_as=nthread;
}
printf(" number of threads =% d\n\n",nthread_mkl_as);
for(i=0;i<64;i++){ptas[i]=0;}
ndim=*neq+(long long)2**nzs;
NNEW(pointersas,ITG,*neq+1);
NNEW(irowpardisoas,ITG,ndim);
NNEW(aupardisoas,double,ndim);
k=0;
/* PARDISO requires the matrix to be stored row by row
aupardisoas contains the entries
irowpardisoas the corresponding column numbers
(for each row in ascending order)
pointersas(i) points to the first entry for row i in
field aupardisoas */
if(*sigma==0.){
for(i=0;i<*neq;i++){
pointersas[i]=k+1;
/* lower left triangular matrix */
for(j=0;j<i;j++){
ifortran=i+1;
lfortran=jq[j+1]-jq[j];
FORTRAN(nident,(&irow[jq[j]-1],&ifortran,&lfortran,&id));
if(id>0){
index=jq[j]+id-2;
if(irow[index]==ifortran){
irowpardisoas[k]=j+1;
aupardisoas[k]=au[index];
k++;
}
}
}
/* diagonal entry */
irowpardisoas[k]=i+1;
aupardisoas[k]=ad[i];
k++;
/* upper right triangular matrix */
for(j=jq[i];j<jq[i+1];j++){
irowpardisoas[k]=irow[j-1];
aupardisoas[k]=au[j+*nzs-1];
k++;
}
}
pointersas[*neq]=k+1;
}else{
for(i=0;i<*neq;i++){
pointersas[i]=k+1;
/* lower left triangular matrix */
for(j=0;j<i;j++){
ifortran=i+1;
lfortran=jq[j+1]-jq[j];
FORTRAN(nident,(&irow[jq[j]-1],&ifortran,&lfortran,&id));
if(id>0){
index=jq[j]+id-2;
if(irow[index]==ifortran){
irowpardisoas[k]=j+1;
aupardisoas[k]=au[index]-*sigma*aub[index];
k++;
}
}
}
/* diagonal entry */
irowpardisoas[k]=i+1;
aupardisoas[k]=ad[i]-*sigma*adb[i];
k++;
/* upper right triangular matrix */
for(j=jq[i];j<jq[i+1];j++){
irowpardisoas[k]=irow[j-1];
aupardisoas[k]=au[j+*nzs-1]-*sigma*aub[j+*nzs-1];
k++;
}
}
pointersas[*neq]=k+1;
}
FORTRAN(pardiso,(ptas,&maxfct,&mnum,&mtype,&phase,neq,aupardisoas,
pointersas,irowpardisoas,perm,&nrhs,iparmas,&msglvl,
b,x,&error));
return;
}
void precontact(ITG *ncont, ITG *ntie, char *tieset, ITG *nset, char *set,
ITG *istartset, ITG *iendset, ITG *ialset, ITG *itietri,
char *lakon, ITG *ipkon, ITG *kon, ITG *koncont, ITG *ne,
double *cg, double *straight, double *co,double *vold,
ITG *istep,ITG *iinc,ITG *iit,ITG *itiefac,
ITG *islavsurf, ITG *islavnode, ITG *imastnode,
ITG *nslavnode, ITG *nmastnode,ITG *imastop,ITG *mi,
ITG *ipe, ITG *ime,double *tietol,ITG *iflagact,
ITG *nintpoint,double **pslavsurfp,double *xmastnor,double *cs,
ITG *mcs,ITG *ics,double *clearini,ITG *nslavs){
/* authors: S. Rakotonanahary, S. Sitzmann and J. Hokkanen */
ITG i,j,ntrimax,*nx=NULL,*ny=NULL,*nz=NULL,im,
l,nstart,kflag,ntri,ii;
double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL,
*pslavsurf=NULL,*clearslavnode=NULL;
pslavsurf=*pslavsurfp;
/* update the location of the center of gravity of
the master triangles and the coefficients of their
bounding planes */
DMEMSET(xmastnor,0,3*nmastnode[*ntie],0.);
FORTRAN(updatecontpen,(koncont,ncont,co,vold,
cg,straight,mi,imastnode,nmastnode,xmastnor,
ntie,tieset,nset,set,istartset,
iendset,ialset,ipkon,lakon,kon,cs,mcs,ics));
/* determining the size of the auxiliary fields
(needed for the master triangle search for any
given location on the slave faces */
ntrimax=0;
for(i=0;i<*ntie;i++){
if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)
ntrimax=itietri[2*i+1]-itietri[2*i]+1;
}
/* only at the start of a new step */
if ((*istep==1)&&(*iinc==1)&&(*iit<=0)){
NNEW(xo,double,ntrimax);
NNEW(yo,double,ntrimax);
NNEW(zo,double,ntrimax);
NNEW(x,double,ntrimax);
NNEW(y,double,ntrimax);
NNEW(z,double,ntrimax);
NNEW(nx,ITG,ntrimax);
NNEW(ny,ITG,ntrimax);
NNEW(nz,ITG,ntrimax);
NNEW(clearslavnode,double,3**nslavs);
FORTRAN(adjustcontactnodes,(tieset,ntie,itietri,cg,straight,
co,vold,xo,yo,zo,x,y,z,nx,ny,nz,istep,iinc,iit,
mi,imastop,nslavnode,islavnode,set,nset,istartset,
iendset,ialset,tietol,clearini,clearslavnode,itiefac,
ipkon,kon,lakon,islavsurf));
SFREE(clearslavnode);
SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);
SFREE(ny);SFREE(nz);
}
void remastruct(ITG *ipompc, double **coefmpcp, ITG **nodempcp, ITG *nmpc,
ITG *mpcfree, ITG *nodeboun, ITG *ndirboun, ITG *nboun,
ITG *ikmpc, ITG *ilmpc, ITG *ikboun, ITG *ilboun,
char *labmpc, ITG *nk,
ITG *memmpc_, ITG *icascade, ITG *maxlenmpc,
ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
ITG *nactdof, ITG *icol, ITG *jq, ITG **irowp, ITG *isolver,
ITG *neq, ITG *nzs,ITG *nmethod, double **fp,
double **fextp, double **bp, double **aux2p, double **finip,
double **fextinip,double **adbp, double **aubp, ITG *ithermal,
ITG *iperturb, ITG *mass, ITG *mi,ITG *iexpl,ITG *mortar,
char *typeboun,double **cvp,double **cvinip,ITG *iit){
/* reconstructs the nonzero locations in the stiffness and mass
matrix after a change in MPC's */
ITG *nodempc=NULL,*mast1=NULL,*ipointer=NULL,mpcend,mpcmult,
callfrommain,i,*irow=NULL,mt,im;
double *coefmpc=NULL,*f=NULL,*fext=NULL,*b=NULL,*aux2=NULL,
*fini=NULL,*fextini=NULL,*adb=NULL,*aub=NULL,*cv=NULL,*cvini=NULL;
nodempc=*nodempcp;coefmpc=*coefmpcp;irow=*irowp;
f=*fp;fext=*fextp;b=*bp;aux2=*aux2p;fini=*finip;
fextini=*fextinip;adb=*adbp;aub=*aubp;cv=*cvp;cvini=*cvinip;
mt=mi[1]+1;
/* decascading the MPC's */
printf(" Decascading the MPC's\n\n");
callfrommain=0;
cascade(ipompc,&coefmpc,&nodempc,nmpc,
mpcfree,nodeboun,ndirboun,nboun,ikmpc,
ilmpc,ikboun,ilboun,&mpcend,&mpcmult,
labmpc,nk,memmpc_,icascade,maxlenmpc,
&callfrommain,iperturb,ithermal);
/* determining the matrix structure */
printf(" Determining the structure of the matrix:\n");
if(nzs[1]<10) nzs[1]=10;
NNEW(mast1,ITG,nzs[1]);
NNEW(ipointer,ITG,mt**nk);
RENEW(irow,ITG,nzs[1]);for(i=0;i<nzs[1];i++) irow[i]=0;
mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
ikmpc,ilmpc,ipointer,nzs,nmethod,ithermal,
ikboun,ilboun,iperturb,mi,mortar,typeboun,labmpc);
SFREE(ipointer);SFREE(mast1);
RENEW(irow,ITG,nzs[2]);
*nodempcp=nodempc;*coefmpcp=coefmpc;*irowp=irow;
/* reallocating fields the size of which depends on neq[1] or *nzs */
RENEW(f,double,neq[1]);DMEMSET(f,0,neq[1],0.);
RENEW(fext,double,neq[1]);DMEMSET(fext,0,neq[1],0.);
RENEW(b,double,neq[1]);DMEMSET(b,0,neq[1],0.);
RENEW(fini,double,neq[1]);
/* for static calculations fini has to be set to f at the
start of the calculation; in dynamic calculations this is
not needed, since the initial accelerations has already
been calculated */
if((*nmethod!=4)&&(*iit==-1)) DMEMSET(fini,0,neq[1],0.);
if(*nmethod==4){
RENEW(aux2,double,neq[1]);DMEMSET(aux2,0,neq[1],0.);
RENEW(cv,double,neq[1]);
RENEW(cvini,double,neq[1]);
RENEW(fextini,double,neq[1]);
// for(i=0;i<neq[1];i++) fextini[i]=0.;
/* the mass matrix is diagonal in an explicit dynamic
calculation and is not changed by contact; this
assumes that the number of degrees of freedom does
not change */
if(*iexpl<=1){
RENEW(adb,double,neq[1]);for(i=0;i<neq[1];i++) adb[i]=0.;
RENEW(aub,double,nzs[1]);for(i=0;i<nzs[1];i++) aub[i]=0.;
mass[0]=1;
}
}
*fp=f;*fextp=fext;*bp=b;*aux2p=aux2;*finip=fini;
*fextinip=fextini;*adbp=adb;*aubp=aub;*cvp=cv;*cvinip=cvini;
return;
}
void expand(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 *neq,
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,ITG *ithermal,double *prestr, ITG *iprestr,
double *vold,ITG *iperturb, double *sti, ITG *nzs,
double *adb, double *aub,char *filab, double *eme,
double *plicon, ITG *nplicon, double *plkcon,ITG *nplkcon,
double *xstate, ITG *npmat_, char *matname, ITG *mi,
ITG *ics, double *cs, ITG *mpcend, ITG *ncmat_,
ITG *nstate_, ITG *mcs, ITG *nkon, double *ener,
char *jobnamec, char *output, char *set, ITG *nset,ITG *istartset,
ITG *iendset, ITG *ialset, ITG *nprint, char *prlab,
char *prset, ITG *nener, double *trab,
ITG *inotr, ITG *ntrans, double *ttime, double *fmpc,
ITG *nev, double **zp, ITG *iamboun, double *xbounold,
ITG *nsectors, ITG *nm,ITG *icol,ITG *irow,ITG *nzl, ITG *nam,
ITG *ipompcold, ITG *nodempcold, double *coefmpcold,
char *labmpcold, ITG *nmpcold, double *xloadold, ITG *iamload,
double *t1old,double *t1,ITG *iamt1, double *xstiff,ITG **icolep,
ITG **jqep,ITG **irowep,ITG *isolver,
ITG *nzse,double **adbep,double **aubep,ITG *iexpl,ITG *ibody,
double *xbody,ITG *nbody,double *cocon,ITG *ncocon,
char* tieset,ITG* ntie,ITG *imddof,ITG *nmddof,
ITG *imdnode,ITG *nmdnode,ITG *imdboun,ITG *nmdboun,
ITG *imdmpc,ITG *nmdmpc, ITG **izdofp, ITG *nzdof,ITG *nherm,
double *xmr,double *xmi){
/* calls the Arnoldi Package (ARPACK) for cyclic symmetry calculations */
char *filabt,*tchar1=NULL,*tchar2=NULL,*tchar3=NULL,lakonl[2]=" \0";
ITG *inum=NULL,k,idir,lfin,j,iout=0,index,inode,id,i,idof,im,
ielas,icmd,kk,l,nkt,icntrl,imag=1,icomplex,kkv,kk6,iterm,
lprev,ilength,ij,i1,i2,iel,ielset,node,indexe,nope,ml1,nelem,
*inocs=NULL,*ielcs=NULL,jj,l1,l2,is,nlabel,*nshcon=NULL,
nodeleft,*noderight=NULL,numnodes,ileft,kflag=2,itr,locdir,
neqh,j1,nodenew,mass[2]={1,1},stiffness=1,buckling=0,mt=mi[1]+1,
rhsi=0,intscheme=0,coriolis=0,istep=1,iinc=1,iperturbmass[2],
*mast1e=NULL,*ipointere=NULL,*irowe=*irowep,*ipobody=NULL,*jqe=*jqep,
*icole=*icolep,tint=-1,tnstart=-1,tnend=-1,tint2=-1,
noderight_,*izdof=*izdofp,iload,iforc,*iznode=NULL,nznode,ll,ne0,
*integerglob=NULL,nasym=0,icfd=0,*inomat=NULL,mortar=0,*islavact=NULL,
*islavnode=NULL,*nslavnode=NULL,*islavsurf=NULL;
long long lint;
double *stn=NULL,*v=NULL,*temp_array=NULL,*vini=NULL,*csmass=NULL,
*een=NULL,cam[5],*f=NULL,*fn=NULL,qa[3],*epn=NULL,summass,
*stiini=NULL,*emn=NULL,*emeini=NULL,*clearini=NULL,
*xstateini=NULL,theta,pi,*coefmpcnew=NULL,t[3],ctl,stl,
*stx=NULL,*enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,
*qfx=NULL,*qfn=NULL,xreal,ximag,*vt=NULL,sum,*aux=NULL,
*coefright=NULL,*physcon=NULL,coef,a[9],ratio,reltime,*ade=NULL,
*aue=NULL,*adbe=*adbep,*aube=*aubep,*fext=NULL,*cgr=NULL,
*shcon=NULL,*springarea=NULL,*z=*zp, *zdof=NULL, *thicke=NULL,
*doubleglob=NULL,atrab[9],acs[9],diff,fin[3],fout[3],*sumi=NULL,
*vti=NULL,*pslavsurf=NULL,*pmastsurf=NULL,*cdn=NULL;
/* dummy arguments for the results call */
double *veold=NULL,*accold=NULL,bet,gam,dtime,time;
pi=4.*atan(1.);
neqh=neq[1]/2;
noderight_=10;
noderight=NNEW(ITG,noderight_);
coefright=NNEW(double,noderight_);
v=NNEW(double,2*mt**nk);
vt=NNEW(double,mt**nk**nsectors);
fn=NNEW(double,2*mt**nk);
stn=NNEW(double,12**nk);
inum=NNEW(ITG,*nk);
stx=NNEW(double,6*mi[0]**ne);
nlabel=46;
filabt=NNEW(char,87*nlabel);
for(i=1;i<87*nlabel;i++) filabt[i]=' ';
filabt[0]='U';
temp_array=NNEW(double,neq[1]);
coefmpcnew=NNEW(double,*mpcend);
nkt=*nsectors**nk;
/* assigning nodes and elements to sectors */
inocs=NNEW(ITG,*nk);
ielcs=NNEW(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;
}
csmass=NNEW(double,*mcs);
if(*mcs==1) csmass[0]=1.;
for(i=0;i<*mcs;i++){
is=cs[17*i];
// 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(*mcs==1){
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 if (strcmp1(&lakon[8*iel+3],"6")==0)nope=6;
else if (strcmp1(&lakon[8*iel],"ES")==0){
lakonl[0]=lakon[8*iel+7];
nope=atoi(lakonl)+1;}
else continue;
}else{
nelem=iel+1;
FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
ithermal,&csmass[i]));
}
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(*mcs==1){
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;}
}else{
nelem=iel+1;
FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
ithermal,&csmass[i]));
}
for(i2=0;i2<nope;++i2){
node=kon[indexe+i2]-1;
inocs[node]=i;
}
}while(1);
}
}
// printf("expand.c mass = %" ITGFORMAT ",%e\n",i,csmass[i]);
}
/* copying imdnode into iznode
iznode contains the nodes in which output is requested and
the nodes in which loading is applied */
iznode=NNEW(ITG,*nk);
for(j=0;j<*nmdnode;j++){iznode[j]=imdnode[j];}
nznode=*nmdnode;
/* expanding imddof, imdnode, imdboun and imdmpc */
for(i=1;i<*nsectors;i++){
for(j=0;j<*nmddof;j++){
imddof[i**nmddof+j]=imddof[j]+i*neqh;
}
for(j=0;j<*nmdnode;j++){
imdnode[i**nmdnode+j]=imdnode[j]+i**nk;
}
for(j=0;j<*nmdboun;j++){
imdboun[i**nmdboun+j]=imdboun[j]+i**nboun;
}
for(j=0;j<*nmdmpc;j++){
imdmpc[i**nmdmpc+j]=imdmpc[j]+i**nmpc;
}
}
(*nmddof)*=(*nsectors);
(*nmdnode)*=(*nsectors);
(*nmdboun)*=(*nsectors);
(*nmdmpc)*=(*nsectors);
/* creating a field with the degrees of freedom in which the eigenmodes
are needed:
1. all dofs in which the solution is needed (=imddof)
2. all dofs in which loading was applied
*/
izdof=NNEW(ITG,neqh**nsectors);
for(j=0;j<*nmddof;j++){izdof[j]=imddof[j];}
*nzdof=*nmddof;
/* generating the coordinates for the other sectors */
icntrl=1;
FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filabt,&imag,mi,emn));
for(jj=0;jj<*mcs;jj++){
is=(ITG)(cs[17*jj]+0.5);
for(i=1;i<is;i++){
theta=i*2.*pi/cs[17*jj];
for(l=0;l<*nk;l++){
if(inocs[l]==jj){
co[3*l+i*3**nk]=co[3*l];
co[1+3*l+i*3**nk]=co[1+3*l]+theta;
co[2+3*l+i*3**nk]=co[2+3*l];
if(*ntrans>0) inotr[2*l+i*2**nk]=inotr[2*l];
}
}
for(l=0;l<*nkon;l++){kon[l+i**nkon]=kon[l]+i**nk;}
for(l=0;l<*ne;l++){
if(ielcs[l]==jj){
if(ipkon[l]>=0){
ipkon[l+i**ne]=ipkon[l]+i**nkon;
ielmat[mi[2]*(l+i**ne)]=ielmat[mi[2]*l];
if(*norien>0) ielorien[l+i**ne]=ielorien[l];
for(l1=0;l1<8;l1++){
l2=8*l+l1;
lakon[l2+i*8**ne]=lakon[l2];
}
}else{
ipkon[l+i**ne]=ipkon[l];
}
}
}
}
}
icntrl=-1;
FORTRAN(rectcyl,(co,vt,fn,stn,qfn,een,cs,&nkt,&icntrl,t,filabt,&imag,mi,emn));
/* expand nactdof */
for(i=1;i<*nsectors;i++){
lint=i*mt**nk;
for(j=0;j<mt**nk;j++){
if(nactdof[j]!=0){
nactdof[lint+j]=nactdof[j]+i*neqh;
}else{
nactdof[lint+j]=0;
}
}
}
/* copying the boundary conditions
(SPC's must be defined in cylindrical coordinates) */
for(i=1;i<*nsectors;i++){
for(j=0;j<*nboun;j++){
nodeboun[i**nboun+j]=nodeboun[j]+i**nk;
ndirboun[i**nboun+j]=ndirboun[j];
xboun[i**nboun+j]=xboun[j];
xbounold[i**nboun+j]=xbounold[j];
if(*nam>0) iamboun[i**nboun+j]=iamboun[j];
ikboun[i**nboun+j]=ikboun[j]+8*i**nk;
ilboun[i**nboun+j]=ilboun[j]+i**nboun;
}
}
/* distributed loads */
for(i=0;i<*nload;i++){
if(nelemload[2*i+1]<*nsectors){
nelemload[2*i]+=*ne*nelemload[2*i+1];
}else{
nelemload[2*i]+=*ne*(nelemload[2*i+1]-(*nsectors));
}
iload=i+1;
FORTRAN(addizdofdload,(nelemload,sideload,ipkon,kon,lakon,
nactdof,izdof,nzdof,mi,&iload,iznode,&nznode,nk,
imdnode,nmdnode));
}
/* body loads */
if(*nbody>0){
printf("*ERROR in expand: body loads are not allowed for modal dynamics\n and steady state dynamics calculations in cyclic symmetric structures\n\n");
FORTRAN(stop,());
}
void biosav(ITG *ipkon,ITG *kon,char *lakon,ITG *ne,double *co,
double *qfx,double *h0,ITG *mi,ITG *inomat,ITG *nk){
ITG i,j,*ithread=NULL,nkphi,idelta,isum;
/* calculates the magnetic intensity due to currents in the phi-
domain of an electromagnetic calculation */
/* variables for multithreading procedure */
ITG sys_cpus;
char *env,*envloc,*envsys;
num_cpus = 0;
sys_cpus=0;
/* explicit user declaration prevails */
envsys=getenv("NUMBER_OF_CPUS");
if(envsys){
sys_cpus=atoi(envsys);
if(sys_cpus<0) sys_cpus=0;
}
/* automatic detection of available number of processors */
if(sys_cpus==0){
sys_cpus = getSystemCPUs();
if(sys_cpus<1) sys_cpus=1;
}
/* local declaration prevails, if strictly positive */
envloc = getenv("CCX_NPROC_BIOTSAVART");
if(envloc){
num_cpus=atoi(envloc);
if(num_cpus<0){
num_cpus=0;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
/* else global declaration, if any, applies */
env = getenv("OMP_NUM_THREADS");
if(num_cpus==0){
if (env)
num_cpus = atoi(env);
if (num_cpus < 1) {
num_cpus=1;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
/* determining the nodal bounds in each thread */
NNEW(nkapar,ITG,num_cpus);
NNEW(nkepar,ITG,num_cpus);
/* n1 is the number of nodes in the phi(magnetostatic)-domain in
an electromagnetic calculation */
nkphi=0;
for(i=0;i<*nk;i++){
if(inomat[i]==1) nkphi++;
}
if(nkphi<num_cpus) num_cpus=nkphi;
idelta=nkphi/num_cpus;
/* dividing the range from 1 to the number of phi-nodes */
isum=0;
for(i=0;i<num_cpus;i++){
nkapar[i]=isum;
if(i!=num_cpus-1){
isum+=idelta;
}else{
isum=nkphi;
}
nkepar[i]=isum-1;
}
/* translating the bounds of the ranges to real node numbers */
i=0;
j=0;
nkphi=-1;
do{
if(j==num_cpus) break;
do{
if(nkapar[j]==nkphi){
nkapar[j]=i;
break;
}else{
do{
i++;
if(inomat[i]==1){
nkphi++;
break;
}
}while(1);
}
}while(1);
do{
if(nkepar[j]==nkphi){
nkepar[j]=i;
j++;
break;
}else{
do{
i++;
if(inomat[i]==1){
nkphi++;
break;
}
}while(1);
}
}while(1);
}while(1);
ipkon1=ipkon;kon1=kon;lakon1=lakon;ne1=ne;co1=co;qfx1=qfx;
h01=h0;mi1=mi;
printf(" Using up to %" ITGFORMAT " cpu(s) for the Biot-Savart calculation.\n\n", num_cpus);
/* create threads and wait */
pthread_t tid[num_cpus];
NNEW(ithread,ITG,num_cpus);
for(i=0;i<num_cpus;i++){
ithread[i]=i;
pthread_create(&tid[i],NULL,(void *)biotsavartmt,(void *)&ithread[i]);
}
for(i=0;i<num_cpus;i++)pthread_join(tid[i], NULL);
SFREE(ithread);SFREE(nkapar);SFREE(nkepar);
return;
}
void tiedcontact(ITG *ntie, char *tieset, ITG *nset, char *set,
ITG *istartset, ITG *iendset, ITG *ialset,
char *lakon, ITG *ipkon, ITG *kon,
double *tietol,
ITG *nmpc, ITG *mpcfree, ITG *memmpc_,
ITG **ipompcp, char **labmpcp, ITG **ikmpcp, ITG **ilmpcp,
double **fmpcp, ITG **nodempcp, double **coefmpcp,
ITG *ithermal, double *co, double *vold, ITG *cfd,
ITG *nmpc_, ITG *mi, ITG *nk,ITG *istep,ITG *ikboun,
ITG *nboun,char *kind1,char *kind2){
char *labmpc=NULL;
ITG *itietri=NULL,*koncont=NULL,nconf,i,k,*nx=NULL,im,
*ny=NULL,*nz=NULL,*ifaceslave=NULL,*istartfield=NULL,
*iendfield=NULL,*ifield=NULL,ntrimax,index,
ncont,ncone,*ipompc=NULL,*ikmpc=NULL,
*ilmpc=NULL,*nodempc=NULL,ismallsliding=0,neq,neqterms,
nmpctied,mortar=0,*ipe=NULL,*ime=NULL,*imastop=NULL,ifreeme;
double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL,
*cg=NULL,*straight=NULL,*fmpc=NULL,*coefmpc=NULL;
ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;
/* identifying the slave surfaces as nodal or facial surfaces */
NNEW(ifaceslave,ITG,*ntie);
FORTRAN(identifytiedface,(tieset,ntie,set,nset,ifaceslave,kind1));
/* determining the number of triangles of the triangulation
of the master surface and the number of entities on the
slave side */
FORTRAN(allocont,(&ncont,ntie,tieset,nset,set,istartset,iendset,
ialset,lakon,&ncone,tietol,&ismallsliding,kind1,
kind2,&mortar,istep));
if(ncont==0){
SFREE(ifaceslave);return;
}
/* allocation of space for the triangulation;
koncont(1..3,i): nodes belonging to triangle i
koncont(4,i): face label to which the triangle belongs =
10*element+side number */
NNEW(itietri,ITG,2**ntie);
NNEW(koncont,ITG,4*ncont);
/* triangulation of the master surface */
FORTRAN(triangucont,(&ncont,ntie,tieset,nset,set,istartset,iendset,
ialset,itietri,lakon,ipkon,kon,koncont,kind1,kind2,co,nk));
/* catalogueing the neighbors of the master triangles */
RENEW(ipe,ITG,*nk);
RENEW(ime,ITG,12*ncont);
DMEMSET(ipe,0,*nk,0.);
DMEMSET(ime,0,12*ncont,0.);
NNEW(imastop,ITG,3*ncont);
FORTRAN(trianeighbor,(ipe,ime,imastop,&ncont,koncont,
&ifreeme));
SFREE(ipe);SFREE(ime);
/* allocation of space for the center of gravity of the triangles
and the 4 describing planes */
NNEW(cg,double,3*ncont);
NNEW(straight,double,16*ncont);
FORTRAN(updatecont,(koncont,&ncont,co,vold,cg,straight,mi));
/* determining the nodes belonging to the slave face surfaces */
NNEW(istartfield,ITG,*ntie);
NNEW(iendfield,ITG,*ntie);
NNEW(ifield,ITG,8*ncone);
FORTRAN(nodestiedface,(tieset,ntie,ipkon,kon,lakon,set,istartset,
iendset,ialset,nset,ifaceslave,istartfield,iendfield,ifield,
&nconf,&ncone,kind1));
/* determining the maximum number of equations neq */
if(*cfd==1){
if(ithermal[1]<=1){
neq=4;
}else{
neq=5;
}
}else{
if(ithermal[1]<=1){
neq=3;
}else if(ithermal[1]==2){
neq=1;
}else{
neq=4;
}
}
neq*=(ncone+nconf);
/* reallocating the MPC fields for the new MPC's
ncone: number of MPC'S due to nodal slave surfaces
nconf: number of MPC's due to facal slave surfaces */
RENEW(ipompc,ITG,*nmpc_+neq);
RENEW(labmpc,char,20*(*nmpc_+neq)+1);
RENEW(ikmpc,ITG,*nmpc_+neq);
RENEW(ilmpc,ITG,*nmpc_+neq);
RENEW(fmpc,double,*nmpc_+neq);
/* determining the maximum number of terms;
expanding nodempc and coefmpc to accommodate
those terms */
neqterms=9*neq;
index=*memmpc_;
(*memmpc_)+=neqterms;
RENEW(nodempc,ITG,3**memmpc_);
RENEW(coefmpc,double,*memmpc_);
for(k=index;k<*memmpc_;k++){
nodempc[3*k-1]=k+1;
}
nodempc[3**memmpc_-1]=0;
/* determining the size of the auxiliary fields */
ntrimax=0;
for(i=0;i<*ntie;i++){
if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)
ntrimax=itietri[2*i+1]-itietri[2*i]+1;
}
NNEW(xo,double,ntrimax);
NNEW(yo,double,ntrimax);
NNEW(zo,double,ntrimax);
NNEW(x,double,ntrimax);
NNEW(y,double,ntrimax);
NNEW(z,double,ntrimax);
NNEW(nx,ITG,ntrimax);
NNEW(ny,ITG,ntrimax);
NNEW(nz,ITG,ntrimax);
/* generating the tie MPC's */
FORTRAN(gentiedmpc,(tieset,ntie,itietri,ipkon,kon,
lakon,set,istartset,iendset,ialset,cg,straight,
koncont,co,xo,yo,zo,x,y,z,nx,ny,nz,nset,
ifaceslave,istartfield,iendfield,ifield,
ipompc,nodempc,coefmpc,nmpc,&nmpctied,mpcfree,ikmpc,ilmpc,
labmpc,ithermal,tietol,cfd,&ncont,imastop,ikboun,nboun,kind1));
(*nmpc_)+=nmpctied;
SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);
SFREE(ny);SFREE(nz);SFREE(imastop);
SFREE(ifaceslave);SFREE(istartfield);SFREE(iendfield);SFREE(ifield);
SFREE(itietri);SFREE(koncont);SFREE(cg);SFREE(straight);
/* reallocating the MPC fields */
/* RENEW(ipompc,ITG,nmpc_);
RENEW(labmpc,char,20*nmpc_+1);
RENEW(ikmpc,ITG,nmpc_);
RENEW(ilmpc,ITG,nmpc_);
RENEW(fmpc,double,nmpc_);*/
*ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
*fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;
/* for(i=0;i<*nmpc;i++){
j=i+1;
FORTRAN(writempc,(ipompc,nodempc,coefmpc,labmpc,&j));
}*/
return;
}
void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
char **sidefacep, ITG *ifreestream,
ITG *nfreestream, ITG *isolidsurf, ITG *neighsolidsurf,
ITG *nsolidsurf, ITG **iponoelp, ITG **inoelp, ITG *nshcon, double *shcon,
ITG *nrhcon, double *rhcon, double **voldp, ITG *ntmat_,ITG *nodeboun,
ITG *ndirboun, ITG *nboun, ITG **ipompcp,ITG **nodempcp, ITG *nmpc,
ITG **ikmpcp, ITG **ilmpcp, ITG *ithermal, ITG *ikboun, ITG *ilboun,
ITG *iturbulent, ITG *isolver, ITG *iexpl, double *vcontu, double *ttime,
double *time, double *dtime, ITG *nodeforc,ITG *ndirforc,double *xforc,
ITG *nforc, ITG *nelemload, char *sideload, double *xload,ITG *nload,
double *xbody,ITG *ipobody,ITG *nbody, ITG *ielmatf, char *matname,
ITG *mi, ITG *ncmat_, double *physcon, ITG *istep, ITG *iinc,
ITG *ibody, double *xloadold, double *xboun,
double **coefmpcp, ITG *nmethod, double *xforcold, double *xforcact,
ITG *iamforc,ITG *iamload, double *xbodyold, double *xbodyact,
double *t1old, double *t1, double *t1act, ITG *iamt1, double *amta,
ITG *namta, ITG *nam, double *ampli, double *xbounold, double *xbounact,
ITG *iamboun, ITG *itg, ITG *ntg, char *amname, double *t0,
ITG **nelemfacep,
ITG *nface, double *cocon, ITG *ncocon, double *xloadact, double *tper,
ITG *jmax, ITG *jout, char *set, ITG *nset, ITG *istartset,
ITG *iendset, ITG *ialset, char *prset, char *prlab, ITG *nprint,
double *trab, ITG *inotr, ITG *ntrans, char *filab, char **labmpcp,
double *sti, ITG *norien, double *orab, char *jobnamef,char *tieset,
ITG *ntie, ITG *mcs, ITG *ics, double *cs, ITG *nkon, ITG *mpcfree,
ITG *memmpc_,double **fmpcp,ITG *nef,ITG **inomatp,double *qfx,
ITG *neifa,ITG *neiel,ITG *ielfa,ITG *ifaext,double *vfa,double *vel,
ITG *ipnei,ITG *nflnei,ITG *nfaext,char *typeboun,ITG *neij,
double *tincf,ITG *nactdoh,ITG *nactdohinv,ITG *ielorienf){
/* main computational fluid dynamics routine */
char cflag[1],*labmpc=NULL,*lakonf=NULL,*sideface=NULL;
char matvec[7]="MATVEC",msolve[7]="MSOLVE";
ITG *ipointer=NULL,*mast1=NULL,*irow=NULL,*icol=NULL,*jq=NULL,
nzs=20000000,neq,kode,compressible,*ifabou=NULL,*ja=NULL,
*nodempc=NULL,*ipompc=NULL,*ikmpc=NULL,*ilmpc=NULL,nfabou,im,
*ipkonf=NULL,*kon=NULL,*nelemface=NULL,*inoel=NULL,last=0,
*iponoel=NULL,*inomat=NULL,ithermalref,*integerglob=NULL,iit,
iconvergence=0,symmetryflag,inputformat,i,*inum=NULL,iitf,ifreefa,
*iponofa=NULL,*inofa=NULL,is,ie,*ia=NULL,nstate_,*ielpropf=NULL,
icent=0,isti=0,iqfx=0,nfield,ndim,iorienglob,force=0,icfdout=1;
ITG nelt,isym,itol,itmax,iunit,lrgw,*igwk=NULL,ligw,ierr,*iwork=NULL,iter,
nsave,lenw,leniw;
double *coefmpc=NULL,*fmpc=NULL,*umfa=NULL,reltime,*doubleglob=NULL,
*co=NULL,*vold=NULL,*coel=NULL,*cosa=NULL,*gradvel=NULL,*gradvfa=NULL,
*xxn=NULL,*xxi=NULL,*xle=NULL,*xlen=NULL,*xlet=NULL,timef,dtimef,
*cofa=NULL,*area=NULL,*xrlfa=NULL,reltimef,ttimef,*hcfa=NULL,*cpel=NULL,
*au=NULL,*ad=NULL,*b=NULL,*volume=NULL,*body=NULL,sigma=0.,betam,
*adb=NULL,*aub=NULL,*advfa=NULL,*ap=NULL,*bp=NULL,*xxj=NULL,
*v=NULL,*velo=NULL,*veloo=NULL,*gammat=NULL,*cosb=NULL,dmin,tincfguess,
*hel=NULL,*hfa=NULL,*auv=NULL,*adv=NULL,*bv=NULL,*sel=NULL,*gamma=NULL,
*gradtfa=NULL,*gradtel=NULL,*umel=NULL,*cpfa=NULL,*gradpel=NULL,
*fn=NULL,*eei=NULL,*xstate=NULL,*ener=NULL,*thicke=NULL,*eme=NULL,
ptimef,*stn=NULL,*qfn=NULL,*hcel=NULL,*aua=NULL,a1,a2,a3,beta,
*prop=NULL;
double tol,*rgwk=NULL,err,*sb=NULL,*sx=NULL,*rwork=NULL;
nodempc=*nodempcp;ipompc=*ipompcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
coefmpc=*coefmpcp;labmpc=*labmpcp;fmpc=*fmpcp;co=*cop;
ipkonf=*ipkonfp;lakonf=*lakonfp;kon=*konp;
nelemface=*nelemfacep;sideface=*sidefacep;inoel=*inoelp;
iponoel=*iponoelp;vold=*voldp;inomat=*inomatp;
#ifdef SGI
ITG token;
#endif
/* relative time at the end of the mechanical increment */
reltime=(*time)/(*tper);
/* open frd-file for fluids */
FORTRAN(openfilefluid,(jobnamef));
/* variables for multithreading procedure */
ITG sys_cpus;
char *env,*envloc,*envsys;
num_cpus = 0;
sys_cpus=0;
/* explicit user declaration prevails */
envsys=getenv("NUMBER_OF_CPUS");
if(envsys){
sys_cpus=atoi(envsys);
if(sys_cpus<0) sys_cpus=0;
}
/* automatic detection of available number of processors */
if(sys_cpus==0){
sys_cpus = getSystemCPUs();
if(sys_cpus<1) sys_cpus=1;
}
/* local declaration prevails, if strictly positive */
envloc = getenv("CCX_NPROC_CFD");
if(envloc){
num_cpus=atoi(envloc);
if(num_cpus<0){
num_cpus=0;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
/* else global declaration, if any, applies */
env = getenv("OMP_NUM_THREADS");
if(num_cpus==0){
if (env)
num_cpus = atoi(env);
if (num_cpus < 1) {
num_cpus=1;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
}
}
// next line is to be inserted in a similar way for all other paralell parts
if(*nef<num_cpus) num_cpus=*nef;
printf(" Using up to %" ITGFORMAT " cpu(s) for CFD.\n", num_cpus);
pthread_t tid[num_cpus];
kode=0;
/* *iexpl==0: structure:implicit, fluid:incompressible
*iexpl==1: structure:implicit, fluid:compressible
*iexpl==2: structure:explicit, fluid:incompressible
*iexpl==3: structure:explicit, fluid:compressible */
if((*iexpl==1)||(*iexpl==3)){
compressible=1;
}else{
compressible=0;
}
/* if initial conditions are specified for the temperature,
it is assumed that the temperature is an unknown */
ithermalref=*ithermal;
if(*ithermal==1){
*ithermal=2;
}
/* determining the matrix structure */
NNEW(ipointer,ITG,3**nk);
NNEW(mast1,ITG,nzs);
NNEW(irow,ITG,nzs);
NNEW(ia,ITG,nzs);
NNEW(icol,ITG,*nef);
NNEW(jq,ITG,*nef+1);
NNEW(ja,ITG,*nef+1);
// NNEW(nactdoh,ITG,*nef);
mastructf(nk,kon,ipkonf,lakonf,nef,icol,jq,&mast1,&irow,
isolver,&neq,ipointer,&nzs,ipnei,neiel,mi);
// printf("Unterschied start\n");
// for(i=0;i<*ne;i++){if(i+1!=nactdoh[i]){printf("Unterschied i=%d,nactdoh[i]=%d\n",i+1,nactdoh[i]);}}
// printf("Unterschied end\n");
SFREE(ipointer);SFREE(mast1);
/* calculation geometric data */
NNEW(coel,double,3**nef);
NNEW(volume,double,*nef);
NNEW(cosa,double,*nflnei);
NNEW(cosb,double,*nflnei);
NNEW(xxn,double,3**nflnei);
NNEW(xxi,double,3**nflnei);
NNEW(xxj,double,3**nflnei);
NNEW(xle,double,*nflnei);
NNEW(xlen,double,*nflnei);
NNEW(xlet,double,*nflnei);
NNEW(cofa,double,3**nface);
NNEW(area,double,*nface);
NNEW(xrlfa,double,3**nface);
FORTRAN(initialcfd,(nef,ipkonf,kon,lakonf,co,coel,cofa,nface,
ielfa,area,ipnei,neiel,xxn,xxi,xle,xlen,xlet,xrlfa,cosa,
volume,neifa,xxj,cosb,vel,&dmin));
/* storing pointers to the boundary conditions in ielfa */
NNEW(ifabou,ITG,7**nfaext);
FORTRAN(applyboun,(ifaext,nfaext,ielfa,ikboun,ilboun,
nboun,typeboun,nelemload,nload,sideload,isolidsurf,nsolidsurf,
ifabou,&nfabou,nface,nodeboun,ndirboun,ikmpc,ilmpc,labmpc,nmpc,
nactdohinv));
RENEW(ifabou,ITG,nfabou);
/* catalogueing the nodes for output purposes (interpolation at
the nodes */
NNEW(iponofa,ITG,*nk);
NNEW(inofa,ITG,2**nface*4);
FORTRAN(cataloguenodes,(iponofa,inofa,&ifreefa,ielfa,ifabou,ipkonf,
kon,lakonf,nface,nk));
RENEW(inofa,ITG,2*ifreefa);
/* material properties for athermal calculations
= calculation for which no initial thermal conditions
were defined */
NNEW(umfa,double,*nface);
NNEW(umel,double,*nef);
/* calculating the density at the element centers */
FORTRAN(calcrhoel,(nef,vel,rhcon,nrhcon,ielmatf,ntmat_,
ithermal,mi));
/* calculating the density at the face centers */
FORTRAN(calcrhofa,(nface,vfa,rhcon,nrhcon,ielmatf,ntmat_,
ithermal,mi,ielfa));
/* calculating the dynamic viscosity at the face centers */
FORTRAN(calcumfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
ithermal,mi,ielfa,umfa));
/* calculating the dynamic viscosity at the element centers */
FORTRAN(calcumel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
ithermal,mi,umel));
if(*ithermal!=0){
NNEW(hcfa,double,*nface);
NNEW(cpel,double,*nef);
NNEW(cpfa,double,*nface);
}