void init(int n)
{
RENEW(t);RENEW(w);RENEW(s);RENEW(mv);
t = new node[n+2];
w = new int[n+2];
mv = new int[n+2];
for(int i = 0;i<=n+1;++i)
mv[i] = t[i].L = t[i].R = t[i].F = 0,w[i]=-INF;
s = new multiset<int>[n+2];
}
/* v_resize -- returns the vector x with dim new_dim
-- x is set to the zero vector */
extern VEC *v_resize(VEC *x, int new_dim)
{
if (new_dim < 0)
error(E_NEG,"v_resize");
if ( ! x )
return v_get(new_dim);
/* nothing is changed */
if (new_dim == x->dim)
return x;
if ( x->max_dim == 0 ) /* assume that it's from sub_vec */
return v_get(new_dim);
if ( new_dim > x->max_dim )
{
if (mem_info_is_on()) {
mem_bytes(TYPE_VEC,x->max_dim*sizeof(Real),
new_dim*sizeof(Real));
}
x->ve = RENEW(x->ve,new_dim,Real);
if ( ! x->ve )
error(E_MEM,"v_resize");
x->max_dim = new_dim;
}
if ( new_dim > x->dim )
__zero__(&(x->ve[x->dim]),new_dim - x->dim);
x->dim = new_dim;
return x;
}
static int
pdf_encoding_new_encoding (const char *enc_name, const char *ident,
const char **encoding_vec,
const char *baseenc_name, int flags)
{
int enc_id, code;
pdf_encoding *encoding;
enc_id = enc_cache.count;
if (enc_cache.count++ >= enc_cache.capacity) {
enc_cache.capacity += 16;
enc_cache.encodings = RENEW(enc_cache.encodings,
enc_cache.capacity, pdf_encoding);
}
encoding = &enc_cache.encodings[enc_id];
pdf_init_encoding_struct(encoding);
encoding->ident = NEW(strlen(ident)+1, char);
strcpy(encoding->ident, ident);
encoding->enc_name = NEW(strlen(enc_name)+1, char);
strcpy(encoding->enc_name, enc_name);
encoding->flags = flags;
for (code = 0; code < 256; code++)
if (encoding_vec[code] && strcmp(encoding_vec[code], ".notdef")) {
encoding->glyphs[code] = NEW(strlen(encoding_vec[code])+1, char);
strcpy(encoding->glyphs[code], encoding_vec[code]);
}
ZVEC *zv_resize(ZVEC *x, int new_dim)
#endif
{
if (new_dim < 0)
error(E_NEG,"zv_resize");
if ( ! x )
return zv_get(new_dim);
if (new_dim == x->dim)
return x;
if ( x->max_dim == 0 ) /* assume that it's from sub_zvec */
return zv_get(new_dim);
if ( new_dim > x->max_dim )
{
if (mem_info_is_on()) {
mem_bytes(TYPE_ZVEC,x->max_dim*sizeof(complex),
new_dim*sizeof(complex));
}
x->ve = RENEW(x->ve,new_dim,complex);
if ( ! x->ve )
error(E_MEM,"zv_resize");
x->max_dim = new_dim;
}
if ( new_dim > x->dim )
__zzero__(&(x->ve[x->dim]),new_dim - x->dim);
x->dim = new_dim;
return x;
}
static int
pdf_path__growpath (pdf_path *p, int max_pe)
{
if (max_pe < p->max_paths)
return 0;
p->max_paths = MAX(p->max_paths + 8, max_pe);
p->path = RENEW(p->path, p->max_paths, pa_elem);
return 0;
}
/* px_resize -- returns the permutation px with size new_size
-- px is set to the identity permutation */
extern PERM *px_resize(PERM *px, int new_size)
{
int i;
if (new_size < 0)
error(E_NEG,"px_resize");
if ( ! px )
return px_get(new_size);
/* nothing is changed */
if (new_size == px->size)
return px;
if ( new_size > px->max_size )
{
if (mem_info_is_on()) {
mem_bytes(TYPE_PERM,px->max_size*sizeof(u_int),
new_size*sizeof(u_int));
}
px->pe = RENEW(px->pe,new_size,u_int);
if ( ! px->pe )
error(E_MEM,"px_resize");
px->max_size = new_size;
}
if ( px->size <= new_size )
/* extend permutation */
for ( i = px->size; i < new_size; i++ )
px->pe[i] = i;
else
for ( i = 0; i < new_size; i++ )
px->pe[i] = i;
px->size = new_size;
return px;
}
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;
}
~lct()
{
RENEW(mv);RENEW(t);RENEW(w);RENEW(s);
}
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;
}
void radcyc(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
double *cs, ITG *mcs, ITG *nkon,ITG *ialset, ITG *istartset,
ITG *iendset,ITG **kontrip,ITG *ntri,
double **cop, double **voldp,ITG *ntrit, ITG *inocs,
ITG *mi){
/* duplicates triangular faces for cyclic radiation conditions */
char *filab=NULL;
ITG i,is,nsegments,idtie,nkt,icntrl,imag=0,*kontri=NULL,mt=mi[1]+1,
node,i1,i2,nope,iel,indexe,j,k,ielset,node1,node2,node3,l,jj;
double *vt=NULL,*fnt=NULL,*stnt=NULL,*eent=NULL,*qfnt=NULL,t[3],theta,
pi,*v=NULL,*fn=NULL,*stn=NULL,*een=NULL,*qfn=NULL,*co=NULL,
*vold=NULL,*emnt=NULL,*emn=NULL;
pi=4.*atan(1.);
kontri=*kontrip;co=*cop;vold=*voldp;
/* determining the maximum number of sectors */
nsegments=1;
for(j=0;j<*mcs;j++){
if(cs[17*j]>nsegments) nsegments=(ITG)(cs[17*j]);
}
/* assigning nodes and elements to sectors */
ielset=cs[12];
if((*mcs!=1)||(ielset!=0)){
for(i=0;i<*nk;i++) inocs[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;
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;
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);
}
}
}
/* duplicating triangular faces
only those faces are duplicated the nodes of which belong to
the same cyclic symmetry. non-integer cyclic symmety numbers are
reduced to the next lower integer. */
*ntrit=nsegments**ntri;
RENEW(kontri,ITG,4**ntrit);
for(i=4**ntri;i<4**ntrit;i++) kontri[i]=0;
for(i=0;i<*ntri;i++){
node1=kontri[4*i];
if(inocs[node1-1]<0) continue;
idtie=inocs[node1-1];
node2=kontri[4*i+1];
if((inocs[node2-1]<0)||(inocs[node2-1]!=idtie)) continue;
node3=kontri[4*i+2];
if((inocs[node3-1]<0)||(inocs[node3-1]!=idtie)) continue;
idtie=cs[17*idtie];
for(k=1;k<idtie;k++){
j=i+k**ntri;
kontri[4*j]=node1+k**nk;
kontri[4*j+1]=node2+k**nk;
kontri[4*j+2]=node3+k**nk;
kontri[4*j+3]=kontri[4*i+3];
}
}
RENEW(co,double,3**nk*nsegments);
RENEW(vold,double,mt**nk*nsegments);
nkt=*nk*nsegments;
/* generating the coordinates for the other sectors */
icntrl=1;
FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
for(jj=0;jj<*mcs;jj++){
is=(ITG)(cs[17*jj]);
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];
}
}
}
}
icntrl=-1;
FORTRAN(rectcyl,(co,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
&imag,mi,emnt));
*kontrip=kontri;*cop=co;*voldp=vold;
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 insert(ITG *ipointer, ITG **irowp, ITG **nextp, ITG *i1,
ITG *i2, ITG *ifree, ITG *nzs_){
/* inserts a new nonzero matrix position into the data structure
in FORTRAN notation:
- ipointer(i) points to a position in field irow containing
the row number of a nonzero position in column i;
next(ipointer(i)) points a position in field irow containing
the row number of another nonzero position in column i, and
so on until no nonzero positions in column i are left; for
the position j in field irow containing the momentarily last
nonzero number in column i we have next(j)=0
notice that in C the positions start at 0 and not at 1 as in
FORTRAN; the present routine is written in FORTRAN convention */
ITG idof1,idof2,istart,*irow=NULL,*next=NULL;
irow=*irowp;
next=*nextp;
if(*i1<*i2){
idof1=*i1;
idof2=*i2;
}
else{
idof1=*i2;
idof2=*i1;
}
if(ipointer[idof2-1]==0){
++*ifree;
if(*ifree>*nzs_){
*nzs_=(ITG)(1.1**nzs_);
RENEW(irow,ITG,*nzs_);
RENEW(next,ITG,*nzs_);
}
ipointer[idof2-1]=*ifree;
irow[*ifree-1]=idof1;
next[*ifree-1]=0;
}
else{
istart=ipointer[idof2-1];
while(1){
if(irow[istart-1]==idof1) break;
if(next[istart-1]==0){
++*ifree;
if(*ifree>*nzs_){
*nzs_=(ITG)(1.1**nzs_);
RENEW(irow,ITG,*nzs_);
RENEW(next,ITG,*nzs_);
}
next[istart-1]=*ifree;
irow[*ifree-1]=idof1;
next[*ifree-1]=0;
break;
}
else{
istart=next[istart-1];
}
}
}
*irowp=irow;
*nextp=next;
return;
}
static void
read_throttlefile( char* throttlefile )
{
FILE* fp;
char buf[5000];
char* cp;
int len;
char pattern[5000];
long limit;
struct timeval tv;
fp = fopen( throttlefile, "r" );
if ( fp == (FILE*) 0 )
{
syslog( LOG_CRIT, "%.80s - %m", throttlefile );
perror( throttlefile );
exit( 1 );
}
(void) gettimeofday( &tv, (struct timezone*) 0 );
while ( fgets( buf, sizeof(buf), fp ) != (char*) 0 )
{
/* Nuke comments. */
cp = strchr( buf, '#' );
if ( cp != (char*) 0 )
*cp = '\0';
/* Nuke trailing whitespace. */
len = strlen( buf );
while ( len > 0 &&
( buf[len-1] == ' ' || buf[len-1] == '\t' ||
buf[len-1] == '\n' || buf[len-1] == '\r' ) )
buf[--len] = '\0';
/* Ignore empty lines. */
if ( len == 0 )
continue;
/* Parse line. */
if ( sscanf( buf, " %4900[^ \t] %ld", pattern, &limit ) != 2 || limit <= 0 )
{
syslog( LOG_CRIT,
"unparsable line in %.80s - %.80s", throttlefile, buf );
(void) fprintf( stderr,
"%s: unparsable line in %.80s - %.80s\n",
argv0, throttlefile, buf );
continue;
}
/* Nuke any leading slashes in pattern. */
if ( pattern[0] == '/' )
(void) strcpy( pattern, &pattern[1] );
while ( ( cp = strstr( pattern, "|/" ) ) != (char*) 0 )
(void) strcpy( cp + 1, cp + 2 );
/* Check for room in throttles. */
if ( numthrottles >= maxthrottles )
{
if ( maxthrottles == 0 )
{
maxthrottles = 100; /* arbitrary */
throttles = NEW( throttletab, maxthrottles );
}
else
{
maxthrottles *= 2;
throttles = RENEW( throttles, throttletab, maxthrottles );
}
if ( throttles == (throttletab*) 0 )
{
syslog( LOG_CRIT, "out of memory allocating a throttletab" );
(void) fprintf(
stderr, "%s: out of memory allocating a throttletab\n",
argv0 );
exit( 1 );
}
}
/* Add to table. */
throttles[numthrottles].pattern = strdup( pattern );
if ( throttles[numthrottles].pattern == (char*) 0 )
{
syslog( LOG_CRIT, "out of memory copying a throttle pattern" );
(void) fprintf(
stderr, "%s: out of memory copying a throttle pattern\n",
argv0 );
exit( 1 );
}
throttles[numthrottles].limit = limit;
throttles[numthrottles].rate = 0;
throttles[numthrottles].bytes_since_avg = 0;
throttles[numthrottles].num_sending = 0;
++numthrottles;
}
(void) fclose( fp );
}
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;
}
long
pdf_defineresource (const char *category,
const char *resname, pdf_obj *object, int flags)
{
int res_id;
struct res_cache *rc;
int cat_id;
pdf_res *res = NULL;
ASSERT(category && object);
cat_id = get_category(category);
if (cat_id < 0) {
ERROR("Unknown resource category: %s", category);
return -1;
}
rc = &resources[cat_id];
if (resname) {
for (res_id = 0; res_id < rc->count; res_id++) {
res = &rc->resources[res_id];
if (!strcmp(resname, res->ident)) {
WARN("Resource %s (category: %s) already defined...",
resname, category);
pdf_flush_resource(res);
res->flags = flags;
if (flags & PDF_RES_FLUSH_IMMEDIATE) {
res->reference = pdf_ref_obj(object);
pdf_release_obj(object);
} else {
res->object = object;
}
return (long) ((cat_id << 16)|(res_id));
}
}
} else {
res_id = rc->count;
}
if (res_id == rc->count) {
if (rc->count >= rc->capacity) {
rc->capacity += CACHE_ALLOC_SIZE;
rc->resources = RENEW(rc->resources, rc->capacity, pdf_res);
}
res = &rc->resources[res_id];
pdf_init_resource(res);
if (resname && resname[0] != '\0') {
res->ident = NEW(strlen(resname) + 1, char);
strcpy(res->ident, resname);
}
res->category = cat_id;
res->flags = flags;
if (flags & PDF_RES_FLUSH_IMMEDIATE) {
res->reference = pdf_ref_obj(object);
pdf_release_obj(object);
} else {
res->object = object;
}
rc->count++;
}
/* m_resize -- returns the matrix A of size new_m x new_n; A is zeroed
-- if A == NULL on entry then the effect is equivalent to m_get() */
extern MAT *m_resize(MAT *A, int new_m, int new_n)
{
int i;
int new_max_m, new_max_n, new_size, old_m, old_n;
if (new_m < 0 || new_n < 0)
error(E_NEG,"m_resize");
if ( ! A )
return m_get(new_m,new_n);
/* nothing was changed */
if (new_m == A->m && new_n == A->n)
return A;
old_m = A->m; old_n = A->n;
if ( new_m > A->max_m )
{ /* re-allocate A->me */
if (mem_info_is_on()) {
mem_bytes(TYPE_MAT,A->max_m*sizeof(Real *),
new_m*sizeof(Real *));
}
A->me = RENEW(A->me,new_m,Real *);
if ( ! A->me )
error(E_MEM,"m_resize");
}
new_max_m = max(new_m,A->max_m);
new_max_n = max(new_n,A->max_n);
#ifndef SEGMENTED
new_size = new_max_m*new_max_n;
if ( new_size > A->max_size )
{ /* re-allocate A->base */
if (mem_info_is_on()) {
mem_bytes(TYPE_MAT,A->max_m*A->max_n*sizeof(Real),
new_size*sizeof(Real));
}
A->base = RENEW(A->base,new_size,Real);
if ( ! A->base )
error(E_MEM,"m_resize");
A->max_size = new_size;
}
/* now set up A->me[i] */
for ( i = 0; i < new_m; i++ )
A->me[i] = &(A->base[i*new_n]);
/* now shift data in matrix */
if ( old_n > new_n )
{
for ( i = 1; i < min(old_m,new_m); i++ )
MEM_COPY((char *)&(A->base[i*old_n]),
(char *)&(A->base[i*new_n]),
sizeof(Real)*new_n);
}
else if ( old_n < new_n )
{
for ( i = (int)(min(old_m,new_m))-1; i > 0; i-- )
{ /* copy & then zero extra space */
MEM_COPY((char *)&(A->base[i*old_n]),
(char *)&(A->base[i*new_n]),
sizeof(Real)*old_n);
__zero__(&(A->base[i*new_n+old_n]),(new_n-old_n));
}
__zero__(&(A->base[old_n]),(new_n-old_n));
A->max_n = new_n;
}
/* zero out the new rows.. */
for ( i = old_m; i < new_m; i++ )
__zero__(&(A->base[i*new_n]),new_n);
#else
if ( A->max_n < new_n )
{
Real *tmp;
for ( i = 0; i < A->max_m; i++ )
{
if (mem_info_is_on()) {
mem_bytes(TYPE_MAT,A->max_n*sizeof(Real),
new_max_n*sizeof(Real));
}
if ( (tmp = RENEW(A->me[i],new_max_n,Real)) == NULL )
error(E_MEM,"m_resize");
else {
A->me[i] = tmp;
}
}
for ( i = A->max_m; i < new_max_m; i++ )
{
if ( (tmp = NEW_A(new_max_n,Real)) == NULL )
error(E_MEM,"m_resize");
else {
A->me[i] = tmp;
if (mem_info_is_on()) {
mem_bytes(TYPE_MAT,0,new_max_n*sizeof(Real));
}
}
}
}
else if ( A->max_m < new_m )
{
for ( i = A->max_m; i < new_m; i++ )
if ( (A->me[i] = NEW_A(new_max_n,Real)) == NULL )
error(E_MEM,"m_resize");
else if (mem_info_is_on()) {
mem_bytes(TYPE_MAT,0,new_max_n*sizeof(Real));
}
}
if ( old_n < new_n )
{
for ( i = 0; i < old_m; i++ )
__zero__(&(A->me[i][old_n]),new_n-old_n);
}
/* zero out the new rows.. */
for ( i = old_m; i < new_m; i++ )
__zero__(A->me[i],new_n);
#endif
A->max_m = new_max_m;
A->max_n = new_max_n;
A->max_size = A->max_m*A->max_n;
A->m = new_m; A->n = new_n;
return A;
}
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);
}