Beispiel #1
0
 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];
 }
Beispiel #2
0
/* 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;
}
Beispiel #3
0
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]);
    }
Beispiel #4
0
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;
}
Beispiel #5
0
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;
}
Beispiel #6
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;
}
Beispiel #8
0
 ~lct()
 {
  RENEW(mv);RENEW(t);RENEW(w);RENEW(s);
 }
Beispiel #9
0
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;

}
Beispiel #10
0
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;
}
Beispiel #11
0
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,());

  }
Beispiel #12
0
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;

}
Beispiel #13
0
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 );
    }
Beispiel #14
0
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;
}
Beispiel #15
0
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++;
  }
Beispiel #16
0
/* 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;
}
Beispiel #17
0
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;
}
Beispiel #18
0
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);
  }