void scanf(char* str, void* buf) {
char temp_buf[100];
__syscall1(11, (uint64_t)temp_buf);
if(strcmp1(str, "%s") == 0)
{
buf = (char *)buf;
// printf("----- %c", temp_buf[0]);
// printf("in");
//buf = temp_buf;
int i = 0;
while(temp_buf[i] != '\0')
*(char *)buf++ = temp_buf[i++];
*(char *)buf = '\0';
// printf("%d", i);
}
else if(strcmp1(str, "%d") == 0)
{
*(int *)buf = stoi(temp_buf);
}
else if(strcmp1(str, "%x") == 0)
{
//buf = temp_buf;
}
}
void mastructf(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
ITG *icol,ITG *jq, ITG **mast1p, ITG **irowp,
ITG *isolver, ITG *neq,ITG *ipointer, ITG *nzs,
ITG *ipnei,ITG *neiel,ITG *mi){
ITG i,j,k,l,index,idof1,idof2,node1,isubtract,nmast,ifree=0,istart,istartold,
nzs_,kflag,isize,*mast1=NULL,*irow=NULL,neighbor,mt=mi[1]+1,numfaces;
/* the indices in the comments follow FORTRAN convention, i.e. the
fields start with 1 */
mast1=*mast1p;irow=*irowp;
kflag=2;
nzs_=*nzs;
*neq=*ne;
/* determining the nonzero locations */
for(i=0;i<*ne;i++){
idof1=i+1;
if(strcmp1(&lakon[8*i+3],"8")==0){
numfaces=6;
}else if(strcmp1(&lakon[8*i+3],"6")==0){
numfaces=5;
}else{
numfaces=4;
}
index=ipnei[i];
insert(ipointer,&mast1,&irow,&idof1,&idof1,&ifree,&nzs_);
for(j=0;j<numfaces;j++){
neighbor=neiel[index+j];
if(neighbor==0) continue;
idof2=neighbor;
insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
}
}
/* storing the nonzero nodes in the SUPERdiagonal columns:
mast1 contains the row numbers,
irow the column numbers */
for(i=0;i<*neq;++i){
if(ipointer[i]==0){
printf("*ERROR in mastructf: zero column\n");
printf(" element=%" ITGFORMAT "\n",i+1);
FORTRAN(stop,());
}
istart=ipointer[i];
while(1){
istartold=istart;
istart=irow[istart-1];
irow[istartold-1]=i+1;
if(istart==0) break;
}
}
int is_var(char *s)
{
int i;
for(i=lvartos-1; i>=call_stack[functos-1]; i--)
if(!strcmp1(local_var_stack[i].var_name, token))
return 1;
for(i=0; i<NUM_GLOBAL_VARS; i++)
if(!strcmp1(global_vars[i].var_name, s))
return 1;
return 0;
}
int find_var(char *s)
{
int i;
for(i=lvartos-1; i>=call_stack[functos-1]; i--)
if(!strcmp1(local_var_stack[i].var_name, token))
return local_var_stack[i].value;
for(i=0; i<NUM_GLOBAL_VARS; i++)
if(!strcmp1(global_vars[i].var_name, s))
return global_vars[i].value;
sntx_err(NOT_VAR);
}
uint8_t insertUser(char (*usernames)[16], uint8_t * strength, char * nuser, uint8_t nstr, uint8_t count) {
int i;
// Is username existing, just update strength if not add him (may delete last
// user for it)
uint8_t found = 0;
for(i=0; i<count; ++i) {
int result = strcmp1(usernames[i], nuser);
if(0 == result) {
strength[i] = nstr;
found = 1;
break;
}
}
if(found==0) {
strength[7] = nstr;
strcpy(nuser, usernames[7]);
usernames[7][strlen(nuser)-1] = '\0';
}
uint8_t swapped = 1;
do {
for(i=1; i<count; ++i) {
if(strength[i-1]>strength[i]) {
swapUsername(usernames[i], usernames[i-1]);
uint8_t stmp = strength[i-1];
strength[i-1] = strength[i];
stmp = strength[i];
swapped = 0;
}
}
} while(swapped==0);
return 0;
}
int main(){
char *str1 = "Yoshihirooo";
char *str2 = "Yoshihiro";
printf("strcmp1(%s, %s) = %d\n", str1, str2, strcmp1(str1, str2));
return 0;
}
/* addtree: add a node with w, at or below p */
struct tnode *addtree(struct tnode *p, char *w,int set,int len)
{
int cond;
if (p == NULL) {
p = talloc();
p->word = strdup1(w);
p->count = 1;
p->set=set;
p->left = p->right = NULL;
}
else if ((cond = strcmp1(w, p->word,len)) == 0){
p->set=0;
p->count++;
}
else if (cond ==-1)
p->left = addtree(p->left, w,0,len);
else if(cond==1)
p->right = addtree(p->right, w,0,len);
else if(cond==-2){
p->left=addtree(p->left,w,1,len);
p->set=1;
}
else if(cond==2){
p->right=addtree(p->right,w,1,len);
p->set=1;
}
return p;
}
char *find_func(char *name)
{
int i;
for(i=0; i<func_index; i++)
if(!strcmp1(name, func_table[i].func_name))
return func_table[i].loc;
return NULL;
}
int main()
{
char *s = "Hello a";
char *t = "Hell";
printf("%d\n", strcmp1(s, t));
printf("%d\n", strcmp2(s, t));
}
int internal_func(char *s)
{
int i;
for(i=0; intern_func[i].f_name[0]; i++) {
if(!strcmp1(intern_func[i].f_name, s))
return i;
}
return -1;
}
void assign_var(char *var_name, int value)
{
int i;
for(i=lvartos-1; i>=call_stack[functos-1]; i--) {
if(!strcmp1(local_var_stack[i].var_name, var_name)) {
local_var_stack[i].value = value;
return;
}
}
if(i < call_stack[functos-1])
for(i=0; i<NUM_GLOBAL_VARS; i++)
if(!strcmp1(global_vars[i].var_name, var_name)) {
global_vars[i].value = value;
return;
}
sntx_err(NOT_VAR);
}
int strend1(char *s, char *t){
int lens;
int lent;
lens = strlen1(s);
lent = strlen1(t);
if(lens<lent){
return 0;
}
return strcmp1(s+lens-lent,t);
}
int main()
{
char s1[] = "test string1";
char s2[] = "test string";
char s3[] = "aaa";
char s4[] = "bbb";
printf("strcmp1(%s, %s) = %d \n", s1, s2, strcmp1(s1, s2));
printf("strcmp2(%s, %s) = %d \n", s3, s4, strcmp2(s3, s4));
return 0;
}
int look_up(char *s)
{
int i;
char *p;
p = s;
while(*p) {
*p |= 0x20;
p++;
}
for(i=0; *table[i].command; i++)
if(!strcmp1(table[i].command, s))
return table[i].tok;
return 0;
}
int main(void) {
char *x = "fiddasdhellowww";
char *s = "hello";
char *w = "hello";
char *t = (char *)calloc(1, sizeof(6));
printf("%d \n", strlen1(s)); // length 6
printf("%s \n", strcpy1(t, s));
printf("%d \n", strcmp1(s, w));
printf("%s \n", findsub(x, s));
zap(t);
return 0;
}
int ch4_string()
{
char *test=malloc(256);
debugStr(utoa1(1132,test));
char *test2="abcdefg";
debugInt((int)strlen1(test2));
debugStr(strcat1(test,test2));
debugStr(strcpy1(test,test2));
debugInt(strend1(test,"g"));
debugInt(strcmp1("1","2"));
debugStr(strncpy1(test,"affgdtwsysgfdgfddsfad",2));
debugStr(strncat1(test,"ABCDEFG",4));
debugInt(strncmp1("12","12223",4));
system("PAUSE");
return 0;
}
int main()
{
char s[] = "bakaka";
std::cout << strlen1(s) << '\n';
strcpy1("ktoksdfsdfsdf56", s);
std::cout << s << '\n';
std::cout << strcmp1(s, "sdf") << ' ' << strcmp1(s, "ktoksdfsdfsdf56") << '\n';
std::cout << strcmp1("sdf", s) << ' ' << strcmp1("ktoksdfsdfsdf56", s) << '\n';
strcpy1("sdf", s);
std::cout << strcmp1("sdf", s) << ' ' << strcmp1("ktoksdfsdfsdf56", s) << '\n';
}
int main () {
//Gets input
char str1[100];
printf("Enter a string ");
fgets(str1, sizeof(str1), stdin);
char str2[100];
printf("Enter a second string ");
fgets(str2, sizeof(str2), stdin);
//Compares inputs
int *a, *b;
a = strcmp1(str1, str2);
b = strcmp(str1, str2);
printf("str: %d \n", b);
printf("func: %d \n", a);
return 0;
}
int main(void)
{
char s[100];
char *t = "Test strcpy;";
strcpy1(s,t);
printf("%s\n", t);
strcpy2(s,t);
printf("%s\n", t);
strcpy3(s,t);
printf("%s\n", t);
strcpy4(s,t);
printf("%s\n", t);
strcpy1(s+strlen1(s),t);
printf("%s\n", s);
printf("%d\n", strcmp1(s,t));
printf("%d\n", strcmp2(s,t));
return 0;
}
void frdselect(double *field1,double *field2,int *iset,int *nkcoords,int *inum,
char *m1,int *istartset,int *iendset,int *ialset,int *ngraph,int *ncomp,
int *ifield,int *icomp,int *nfield,int *iselect,char *m2,FILE *f1,
char *output, char*m3){
/* storing scalars, components of vectors and tensors without additional
transformations */
/* number of components in field1: nfield[0]
number of components in field2: nfield[1]
number of entities to store: ncomp
for each entity i, 0<=i<ncomp:
- ifield[i]: 1=field1,2=field2
- icomp[i]: component: 0...,(nfield[0]-1 or nfield[1]-1) */
int i,j,k,l,m,n,nksegment;
int iw;
float ifl;
if(*iset==0){
for(i=0;i<*nkcoords;i++){
/* check whether output is requested for solid nodes or
network nodes */
if(*iselect==1){
if(inum[i]<=0) continue;
}else if(*iselect==-1){
if(inum[i]>=0) continue;
}else{
if(inum[i]==0) continue;
}
/* storing the entities */
for(n=1;n<=(int)((*ncomp+5)/6);n++){
if(n==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%3s%10d",m1,i+1);
}else{
iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
}
for(j=0;j<min(6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}else{
if(strcmp1(output,"asc")==0)fprintf(f1,"%3s ",m2);
for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}
}
}
}else{
nksegment=(*nkcoords)/(*ngraph);
for(k=istartset[*iset-1]-1;k<iendset[*iset-1];k++){
if(ialset[k]>0){
for(l=0;l<*ngraph;l++){
i=ialset[k]+l*nksegment-1;
/* check whether output is requested for solid nodes or
network nodes */
if(*iselect==1){
if(inum[i]<=0) continue;
}else if(*iselect==-1){
if(inum[i]>=0) continue;
}else{
if(inum[i]==0) continue;
}
/* storing the entities */
for(n=1;n<=(int)((*ncomp+5)/6);n++){
if(n==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%3s%10d",m1,i+1);
}else{
iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
}
for(j=0;j<min(6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}else{
if(strcmp1(output,"asc")==0)fprintf(f1,"%3s ",m2);
for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+j]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+j]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}
}
}
}else{
l=ialset[k-2];
do{
l-=ialset[k];
if(l>=ialset[k-1]) break;
for(m=0;m<*ngraph;m++){
i=l+m*nksegment-1;
/* check whether output is requested for solid nodes or
network nodes */
if(*iselect==1){
if(inum[i]<=0) continue;
}else if(*iselect==-1){
if(inum[i]>=0) continue;
}else{
if(inum[i]==0) continue;
}
/* storing the entities */
for(n=1;n<=(int)((*ncomp+5)/6);n++){
if(n==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%3s%10d",m1,i+1);
}else{
iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
}
for(j=0;j<min(6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}else{
if(strcmp1(output,"asc")==0)fprintf(f1,"%3s ",m2);
for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
if(ifield[j]==1){
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+j]);
}else{
ifl=(float)field1[i*nfield[0]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}else{
if(strcmp1(output,"asc")==0){
fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+j]);
}else{
ifl=(float)field2[i*nfield[1]+icomp[j]];
fwrite(&ifl,sizeof(float),1,f1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
}
}
}
}while(1);
}
}
}
if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
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 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 mastructcs(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
ITG *nodeboun, ITG *ndirboun, ITG *nboun, ITG *ipompc,
ITG *nodempc, ITG *nmpc, ITG *nactdof, ITG *icol,
ITG *jq, ITG **mast1p, ITG **irowp, ITG *isolver, ITG *neq,
ITG *ikmpc, ITG *ilmpc,ITG *ipointer, ITG *nzs,
ITG *nmethod,ITG *ics, double *cs, char *labmpc, ITG *mcs,
ITG *mi,ITG *mortar){
/* determines the structure of the thermo-mechanical matrices with
cyclic symmetry;
(i.e. the location of the nonzeros */
char lakonl[2]=" \0";
ITG i,j,k,l,jj,ll,id,index,jdof1,jdof2,idof1,idof2,mpc1,mpc2,id1,id2,
ist1,ist2,node1,node2,isubtract,nmast,ifree,istart,istartold,
index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
*irow=NULL,inode,icomplex,inode1,icomplex1,inode2,
icomplex2,kdof1,kdof2,ilength,lprev,ij,mt=mi[1]+1;
/* the indices in the comments follow FORTRAN convention, i.e. the
fields start with 1 */
mast1=*mast1p;
irow=*irowp;
kflag=2;
nzs_=nzs[1];
/* initialisation of nactmpc */
for(i=0;i<mt**nk;++i){nactdof[i]=0;}
/* determining the active degrees of freedom due to elements */
for(i=0;i<*ne;++i){
if(ipkon[i]<0) continue;
indexe=ipkon[i];
/* Bernhardi start */
if (strcmp1(&lakon[8*i+3],"8I")==0)nope=11;
else if(strcmp1(&lakon[8*i+3],"20")==0)nope=20;
/* Bernhardi end */
else if(strcmp1(&lakon[8*i+3],"2")==0)nope=26;
else if (strcmp1(&lakon[8*i+3],"8")==0)nope=8;
else if (strcmp1(&lakon[8*i+3],"10")==0)nope=10;
else if ((strcmp1(&lakon[8*i+3],"4")==0)||
(strcmp1(&lakon[8*i+2],"4")==0)) nope=4;
else if (strcmp1(&lakon[8*i+3],"15")==0)nope=15;
else if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
else if (strcmp1(&lakon[8*i],"E")==0){
if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
nope=kon[ipkon[i]-1];
}else{
lakonl[0]=lakon[8*i+7];
nope=atoi(lakonl)+1;
}
}else continue;
/* else if (strcmp1(&lakon[8*i],"E")==0){
lakonl[0]=lakon[8*i+7];
nope=atoi(lakonl)+1;}
else continue;*/
for(j=0;j<nope;++j){
node=kon[indexe+j]-1;
for(k=1;k<4;++k){
nactdof[mt*node+k]=1;
}
}
}
/* determining the active degrees of freedom due to mpc's */
for(i=0;i<*nmpc;++i){
index=ipompc[i]-1;
do{
if((nodempc[3*index+1]!=0)&&(nodempc[3*index+1]<4)){
nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=1;}
index=nodempc[3*index+2];
if(index==0) break;
index--;
}while(1);
}
/* subtracting the SPC and MPC nodes */
for(i=0;i<*nboun;++i){
if(ndirboun[i]>mi[1]) continue;
nactdof[mt*(nodeboun[i]-1)+ndirboun[i]]=0;
}
for(i=0;i<*nmpc;++i){
index=ipompc[i]-1;
if(nodempc[3*index+1]>mi[1]) continue;
nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=0;
}
/* numbering the active degrees of freedom */
neq[0]=0;
for(i=0;i<*nk;++i){
for(j=1;j<4;++j){
if(nactdof[mt*i+j]!=0){
++neq[0];
nactdof[mt*i+j]=neq[0];
}
}
}
ifree=0;
/* determining the position of each nonzero matrix element
mast1(ipointer(i)) = first nonzero row in column i
irow(ipointer(i)) points to further nonzero elements in
column i */
for(i=0;i<6**nk;++i){ipointer[i]=0;}
for(i=0;i<*ne;++i){
if(ipkon[i]<0) continue;
indexe=ipkon[i];
/* Bernhardi start */
if(strcmp1(&lakon[8*i],"C3D8I")==0){nope=11;}
else if(strcmp1(&lakon[8*i+3],"20")==0)nope=20;
/* Bernhardi end */
else if(strcmp1(&lakon[8*i+3],"2")==0)nope=26;
else if (strcmp1(&lakon[8*i+3],"8")==0)nope=8;
else if (strcmp1(&lakon[8*i+3],"10")==0)nope=10;
else if (strcmp1(&lakon[8*i+3],"4")==0)nope=4;
else if (strcmp1(&lakon[8*i+3],"15")==0)nope=15;
else if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
else if (strcmp1(&lakon[8*i],"E")==0){
if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
nope=kon[ipkon[i]-1];
}else{
lakonl[0]=lakon[8*i+7];
nope=atoi(lakonl)+1;
}
}else continue;
/* else if (strcmp1(&lakon[8*i],"E")==0){
lakonl[0]=lakon[8*i+7];
nope=atoi(lakonl)+1;}
else continue;*/
for(jj=0;jj<3*nope;++jj){
j=jj/3;
k=jj-3*j;
node1=kon[indexe+j];
jdof1=nactdof[mt*(node1-1)+k+1];
for(ll=jj;ll<3*nope;++ll){
l=ll/3;
m=ll-3*l;
node2=kon[indexe+l];
jdof2=nactdof[mt*(node2-1)+m+1];
/* check whether one of the DOF belongs to a SPC or MPC */
if((jdof1!=0)&&(jdof2!=0)){
insert(ipointer,&mast1,&irow,&jdof1,&jdof2,&ifree,&nzs_);
kdof1=jdof1+neq[0];kdof2=jdof2+neq[0];
insert(ipointer,&mast1,&irow,&kdof1,&kdof2,&ifree,&nzs_);
}
else if((jdof1!=0)||(jdof2!=0)){
/* idof1: genuine DOF
idof2: nominal DOF of the SPC/MPC */
if(jdof1==0){
idof1=jdof2;
idof2=8*node1+k-7;}
else{
idof1=jdof1;
idof2=8*node2+m-7;}
if(*nmpc>0){
FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
if((id>0)&&(ikmpc[id-1]==idof2)){
/* regular DOF / MPC */
id1=ilmpc[id-1];
ist=ipompc[id1-1];
index=nodempc[3*ist-1];
if(index==0) continue;
while(1){
inode=nodempc[3*index-3];
icomplex=0;
if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
icomplex=atoi(&labmpc[20*(id1-1)+6]);
}
else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
for(ij=0;ij<*mcs;ij++){
ilength=cs[17*ij+3];
lprev=cs[17*ij+13];
FORTRAN(nident,(&ics[lprev],&inode,&ilength,&id));
if(id>0){
if(ics[lprev+id-1]==inode){
icomplex=ij+1;
break;
}
}
}
}
// idof2=nactdof[mt*inode+nodempc[3*index-2]-4];
idof2=nactdof[mt*(inode-1)+nodempc[3*index-2]];
if(idof2!=0){
insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
kdof1=idof1+neq[0];kdof2=idof2+neq[0];
insert(ipointer,&mast1,&irow,&kdof1,&kdof2,&ifree,&nzs_);
if((icomplex!=0)&&(idof1!=idof2)){
insert(ipointer,&mast1,&irow,&kdof1,&idof2,&ifree,&nzs_);
insert(ipointer,&mast1,&irow,&idof1,&kdof2,&ifree,&nzs_);
}
}
index=nodempc[3*index-1];
if(index==0) break;
}
continue;
}
}
}
else{
idof1=8*node1+k-7;
idof2=8*node2+m-7;
mpc1=0;
mpc2=0;
if(*nmpc>0){
FORTRAN(nident,(ikmpc,&idof1,nmpc,&id1));
if((id1>0)&&(ikmpc[id1-1]==idof1)) mpc1=1;
FORTRAN(nident,(ikmpc,&idof2,nmpc,&id2));
if((id2>0)&&(ikmpc[id2-1]==idof2)) mpc2=1;
}
if((mpc1==1)&&(mpc2==1)){
id1=ilmpc[id1-1];
id2=ilmpc[id2-1];
if(id1==id2){
/* MPC id1 / MPC id1 */
ist=ipompc[id1-1];
index1=nodempc[3*ist-1];
if(index1==0) continue;
while(1){
inode1=nodempc[3*index1-3];
icomplex1=0;
if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
icomplex1=atoi(&labmpc[20*(id1-1)+6]);
}
else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
for(ij=0;ij<*mcs;ij++){
ilength=cs[17*ij+3];
lprev=cs[17*ij+13];
FORTRAN(nident,(&ics[lprev],&inode1,&ilength,&id));
if(id>0){
if(ics[lprev+id-1]==inode1){
icomplex1=ij+1;
break;
}
}
}
}
// idof1=nactdof[mt*inode1+nodempc[3*index1-2]-4];
idof1=nactdof[mt*(inode1-1)+nodempc[3*index1-2]];
index2=index1;
while(1){
inode2=nodempc[3*index2-3];
icomplex2=0;
if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
icomplex2=atoi(&labmpc[20*(id1-1)+6]);
}
else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
for(ij=0;ij<*mcs;ij++){
ilength=cs[17*ij+3];
lprev=cs[17*ij+13];
FORTRAN(nident,(&ics[lprev],&inode2,&ilength,&id));
if(id>0){
if(ics[lprev+id-1]==inode2){
icomplex2=ij+1;
break;
}
}
}
}
// idof2=nactdof[mt*inode2+nodempc[3*index2-2]-4];
idof2=nactdof[mt*(inode2-1)+nodempc[3*index2-2]];
if((idof1!=0)&&(idof2!=0)){
insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
kdof1=idof1+neq[0];kdof2=idof2+neq[0];
insert(ipointer,&mast1,&irow,&kdof1,&kdof2,&ifree,&nzs_);
if(((icomplex1!=0)||(icomplex2!=0))&&
(icomplex1!=icomplex2)){
/* if(((icomplex1!=0)||(icomplex2!=0))&&
((icomplex1==0)||(icomplex2==0))){*/
insert(ipointer,&mast1,&irow,&kdof1,&idof2,&ifree,&nzs_);
insert(ipointer,&mast1,&irow,&idof1,&kdof2,&ifree,&nzs_);
}
}
index2=nodempc[3*index2-1];
if(index2==0) break;
}
index1=nodempc[3*index1-1];
if(index1==0) break;
}
}
else{
/* MPC id1 /MPC id2 */
ist1=ipompc[id1-1];
index1=nodempc[3*ist1-1];
if(index1==0) continue;
while(1){
inode1=nodempc[3*index1-3];
icomplex1=0;
if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
icomplex1=atoi(&labmpc[20*(id1-1)+6]);
}
else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
for(ij=0;ij<*mcs;ij++){
ilength=cs[17*ij+3];
lprev=cs[17*ij+13];
FORTRAN(nident,(&ics[lprev],&inode1,&ilength,&id));
if(id>0){
if(ics[lprev+id-1]==inode1){
icomplex1=ij+1;
break;
}
}
}
}
// idof1=nactdof[mt*inode1+nodempc[3*index1-2]-4];
idof1=nactdof[mt*(inode1-1)+nodempc[3*index1-2]];
ist2=ipompc[id2-1];
index2=nodempc[3*ist2-1];
if(index2==0){
index1=nodempc[3*index1-1];
if(index1==0){break;}
else{continue;}
}
while(1){
inode2=nodempc[3*index2-3];
icomplex2=0;
if(strcmp1(&labmpc[(id2-1)*20],"CYCLIC")==0){
icomplex2=atoi(&labmpc[20*(id2-1)+6]);
}
else if(strcmp1(&labmpc[(id2-1)*20],"SUBCYCLIC")==0){
for(ij=0;ij<*mcs;ij++){
ilength=cs[17*ij+3];
lprev=cs[17*ij+13];
FORTRAN(nident,(&ics[lprev],&inode2,&ilength,&id));
if(id>0){
if(ics[lprev+id-1]==inode2){
icomplex2=ij+1;
break;
}
}
}
}
// idof2=nactdof[mt*inode2+nodempc[3*index2-2]-4];
idof2=nactdof[mt*(inode2-1)+nodempc[3*index2-2]];
if((idof1!=0)&&(idof2!=0)){
insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
kdof1=idof1+neq[0];kdof2=idof2+neq[0];
insert(ipointer,&mast1,&irow,&kdof1,&kdof2,&ifree,&nzs_);
if(((icomplex1!=0)||(icomplex2!=0))&&
(icomplex1!=icomplex2)){
/* if(((icomplex1!=0)||(icomplex2!=0))&&
((icomplex1==0)||(icomplex2==0))){*/
insert(ipointer,&mast1,&irow,&kdof1,&idof2,&ifree,&nzs_);
insert(ipointer,&mast1,&irow,&idof1,&kdof2,&ifree,&nzs_);
}
}
index2=nodempc[3*index2-1];
if(index2==0) break;
}
index1=nodempc[3*index1-1];
if(index1==0) break;
}
}
}
}
}
}
}
neq[0]=2*neq[0];
neq[1]=neq[0];
/* ordering the nonzero nodes in the SUPERdiagonal columns
mast1 contains the row numbers column per column,
irow the column numbers */
/* for(i=0;i<neq[0];++i){
itot=0;
if(ipointer[i]==0){
printf("*ERROR in mastructcs: zero column");
FORTRAN(stop,());
}
istart=ipointer[i];
while(1){
++itot;
ikcol[itot-1]=mast1[istart-1];
istart=irow[istart-1];
if(istart==0) break;
}
FORTRAN(isortii,(ikcol,icol,&itot,&kflag));
istart=ipointer[i];
for(j=0;j<itot-1;++j){
mast1[istart-1]=ikcol[j];
istartold=istart;
istart=irow[istart-1];
irow[istartold-1]=i+1;
}
mast1[istart-1]=ikcol[itot-1];
irow[istart-1]=i+1;
}*/
for(i=0;i<neq[0];++i){
if(ipointer[i]==0){
if(i>=neq[1]) continue;
printf("*ERROR in mastructcs: zero column\n");
FORTRAN(stop,());
}
istart=ipointer[i];
while(1){
istartold=istart;
istart=irow[istart-1];
irow[istartold-1]=i+1;
if(istart==0) break;
}
}
if(neq[0]==0){
printf("\n*WARNING: no degrees of freedom in the model\n");
FORTRAN(stop,());
}
void radcyc(int *nk,int *kon,int *ipkon,char *lakon,int *ne,
double *cs, int *mcs, int *nkon,int *ialset, int *istartset,
int *iendset,int **kontrip,int *ntri,
double **cop, double **voldp,int *ntrit, int *inocs,
int *mi){
/* duplicates triangular faces for cyclic radiation conditions */
char *filab=NULL;
int 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=(int)(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,int,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=(int)(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 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 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 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,());
}
