454-calculix Report

**454-calculix**
Exec Time (%)	Codelet Name	Error (%)
66.4	CalculiX_main_181	42.7
3.6	mastruct_mastruct_615	0.9
9.2	isortii_isortii__199	18.7
3.8	SPOOLES_FrontMtx_src_FrontMtx_update_Fr...	85.7
3.8	SPOOLES_Chv_src_Chv_update_Chv_updateS_...	6.0
8.4	mafillsm_mafillsm__146	1.2
2.1	e_c3d_e_c3d__247	14.8
1.9	SPOOLES_Utilities_src_Utilities_newsort...	6.6
9.2	isortii_isortii__199	18.7
3.2	mastruct_mastruct_705	0.1
9.2	isortii_isortii__199	18.7
1.3	SPOOLES_Chv_src_Chv_factor_symmetric1x1...	38.9
14.8	mastruct_mastruct_331	1.0
2.5	SPOOLES_Utilities_src_Utilities_sortAnd...	1.3
3.5	results_results__1301	97.2
2.6	SPOOLES_InpMtx_src_InpMtx_fullAdj_InpMt...	5.9
1.6	results_results__1256	94.7
1.8	spooles_spooles_86	7.1
1.7	CalculiX_main_145	99.9

Exec Time : 1.306602e+08 cycles

Matching : 40.0%

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Chv_src_Chv_factor_symmetric1x1_600

Real time: 1.753996e+06 -- Predicted time: 2.873963e+06

Callcount: 720

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
198	### 1	291.171626984127	5.787000e+03	4.032000e+03	30.3
362	### 2	505.937269372694	2.350000e+03	1.084000e+03	53.8

                /*     CalculiX - A 3-dimensional finite element program                 */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                                                                       */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdlib.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "CalculiX.h"

#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))

void mastruct(int *nk, int *kon, int *ipkon, char *lakon, int *ne,
	      int *nodeboun, int *ndirboun, int *nboun, int *ipompc,
	      int *nodempc, int *nmpc, int *nactdof, int *icol,
	      int *jq, int **mast1p, int **irowp, int *isolver, int *neq,
	      int *nnn, int *ikmpc, int *ilmpc, int *ikcol,
	      int *ipointer, int *nsky, int *nzs, int *nmethod,
              int *ithermal){

  int 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,itot,
    index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
    *irow=NULL,nsky_exp,nsky_inc;

  /* the indices in the comments follow FORTRAN convention, i.e. the
     fields start with 1 */

  mast1=*mast1p;
  irow=*irowp;

  kflag=2;
  nzs_=*nzs;

  /* initialisation of nactmpc */

  for(i=0;i<4**nk;++i){nactdof[i]=0;}

  /* determining the mechanical active degrees of freedom due to elements */

  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      for(k=1;k<4;++k){
		  nactdof[4*node+k]=1;
	      }
	  }
      }
  }

  /* determining the thermal active degrees of freedom due to elements */

  if(*ithermal>1){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      nactdof[4*node]=1;
	  }
      }
  }

  /* determining the active degrees of freedom due to mpc's */

  for(i=0;i<*nmpc;++i){
      index=ipompc[i]-1;
      do{
	  nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=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]>3){continue;}
      nactdof[4*(nodeboun[i]-1)+ndirboun[i]]=0;
  }

  for(i=0;i<*nmpc;++i){
    index=ipompc[i]-1;
    nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=0;
  }
  
  /* numbering the active degrees of freedom */
  
  *neq=0;
  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*nk;++i){
	  for(j=1;j<4;++j){
	      if(nactdof[4*nnn[i]+j-4]!=0){
		  ++*neq;
		  nactdof[4*nnn[i]+j-4]=*neq;
	      }
	  }
      }
  }
  if(*ithermal>1){
      for(i=0;i<*nk;++i){
	  if(nactdof[4*nnn[i]-4]!=0){
	      ++*neq;
	      nactdof[4*nnn[i]-4]=*neq;
	  }
      }
  }
  
  ifree=0;
  
  /* determining the position of the skyline only */
  
  if(*isolver==1){
    
    /* ipointer(i) = first nonzero row number in column i */
    
    for(i=0;i<4**nk;++i){ipointer[i]=i+1;}
    
    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-1)+m+1];
	  
	  /* check whether one of the DOF belongs to a SPC or MPC */
	  
	  if((jdof1!=0)&&(jdof2!=0)){
	    ipointer[max(jdof1,jdof2)-1]=
	      min(ipointer[max(jdof1,jdof2)-1],min(jdof1,jdof2));
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    ipointer[max(idof1,idof2)-1]=
		      min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }
    
    /* defining icol and jq
       
       jq(i) = first nonzero row element in column i
       icol(i) = length of skyline up to and including column i */
    
    icol[0]=0;
    for(i=1;i<*neq;++i){
      jq[i]=ipointer[i];
      icol[i]=icol[i-1]+i-jq[i]+1;
    }
    *nsky=icol[*neq-1];

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("total length of the skyline\n");
    printf("%d\n\n",icol[*neq-1]);
    
  }
  else{

    /* 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<4**nk;++i){ipointer[i]=0;}

    /* mechanical entries */
    
    if((*ithermal<2)||(*ithermal==3)){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }

    /* thermal entries*/

    if(*ithermal>1){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<nope;++jj){
	
	j=jj;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)];
	
	for(ll=jj;ll<nope;++ll){
	  
	  l=ll;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1-7;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2-7;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1-7;
	    idof2=7*node2-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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }
    
    /* 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;++i){
      itot=0;
      if(ipointer[i]==0){
	printf("error in mastruct: zero column\n");
	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;
    }

    /* definiing icol and jq */

    *nsky=0;
    nsky_exp=0;
    for(i=1;i<*neq;++i){
      nsky_inc=i+1-mast1[ipointer[i]-1];
      if(2147483647-*nsky<nsky_inc){
	++nsky_exp;
	nsky_inc=nsky_inc-2147483647;
      }
      *nsky=*nsky+nsky_inc;
    }

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("number of nonzero matrix elements\n");
    printf("%d\n",ifree);
    printf("total length of the skyline\n");
    printf("%d*2147483647+%d\n",nsky_exp,*nsky);
    printf("percentage of nonzero skyline elements\n");
    printf("%f\n\n",((double)ifree)/
	   ((double)(*nsky+*neq)+nsky_exp*(double)(2147483647))*100.);

    /* new meaning of icol,j1,mast1,irow:

       - irow is going to contain the row numbers of the SUBdiagonal
         nonzero's, column per column
       - mast1 contains the column numbers
       - icol(i)=# SUBdiagonal nonzero's in column i
       - jq(i)= location in field irow of the first SUBdiagonal
         nonzero in column i

	 */

    nmast=ifree;

    /* switching from a SUPERdiagonal inventory to a SUBdiagonal one */

    FORTRAN(isortii,(mast1,irow,&nmast,&kflag));
    
    /* filtering out the diagonal elements and generating icol and jq */

    isubtract=0;
    for(i=1;i<*neq;++i){icol[i]=0;}
    k=0;
    for(i=0;i<nmast;++i){
      if(mast1[i]==irow[i]){++isubtract;}
      else{
	mast1[i-isubtract]=mast1[i];
	irow[i-isubtract]=irow[i];
	if(k!=mast1[i]){
	  for(l=k;l<mast1[i];++l){jq[l]=i+1-isubtract;}
	  k=mast1[i];
	}
	++icol[k-1];
      }
    }
    nmast=nmast-isubtract;
    for(l=k;l<*neq+1;++l){jq[l]=nmast+1;}

    for(i=0;i<*neq;++i){
      if(jq[i+1]-jq[i]>0){
	isize=jq[i+1]-jq[i];
	FORTRAN(isortii,(&irow[jq[i]-1],&mast1[jq[i]-1],&isize,&kflag));
      }
    }

    *nzs=jq[*neq-1]-1;

  }

  *mast1p=mast1;
  *irowp=irow;

  return;

}
	  
/*

What follows is the original FORTRAN code. The C Code is a one-to-one
manual translation of the FORTRAN code. However, the FORTRAN code might
be easier to understand.

!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
     &  nboun,ipompc,
     &  nodempc,nmpc,nactdof,icol,jq,mast1,irow,isolver,neq,nnn,
     &  ikmpc,ilmpc,ikcol,ipointer,nsky,nzs,nmethod)
!
      implicit none
!
      character*6 lakon(*)
!
      integer kon(*),nodeboun(*),ndirboun(*),nodempc(3,*),ipompc(*),
     &  nactdof(3,*),icol(*),jq(*),ipointer(*),nnn(*),ikmpc(*),ilmpc(*),
     &  ikcol(*),mast1(*),irow(*),ipkon(*)
!
      integer nk,ne,nboun,nmpc,isolver,neq,nsky,nzs,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,itot,index1,index2,
     &  m,node,nzs_,ist,kflag,nmethod,indexe,nope,nsky_exp,nsky_inc
!
      kflag=2
      nzs_=nzs
!
!     initialisation of nactmpc
!
      do i=1,nk
        do j=1,3
          nactdof(j,i)=0
        enddo
      enddo
!
!     determining the active degrees of freedom due to elements
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
            nope=20
         elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
            nope=8
         else
            nope=10
         endif
!
         do j=1,nope
            node=kon(indexe+j)
            do k=1,3
               nactdof(k,node)=1
            enddo
         enddo
      enddo
!
!     determining the active degrees of freedom due to mpc's
!
      do i=1,nmpc
         index=ipompc(i)
         do
            nactdof(nodempc(2,index),nodempc(1,index))=1
            index=nodempc(3,index)
	    if(index.eq.0) exit
	 enddo
      enddo
!      
!     subtracting the SPC and MPC nodes
!
      do i=1,nboun
        nactdof(ndirboun(i),nodeboun(i))=0
      enddo
!
      do i=1,nmpc
         index=ipompc(i)
         nactdof(nodempc(2,index),nodempc(1,index))=0
      enddo
!
!     numbering the active degrees of freedom
!
      neq=0
      do i=1,nk
        do j=1,3
          if(nactdof(j,nnn(i)).ne.0) then
            neq=neq+1
            nactdof(j,nnn(i))=neq
          endif
        enddo
      enddo
!
      ifree=0
!
!     determining the position of the skyline only
!
      if(isolver.eq.1) then
!
!       ipointer(i) = first nonzero row number in column i
!
        do i=1,3*nk
          ipointer(i)=i
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 ipointer(max(jdof1,jdof2))=
     &             min(ipointer(max(jdof1,jdof2)),min(jdof1,jdof2))
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       defining icol and jq
!
!       jq(i) = first nonzero row element in column i
!       icol(i) = length of skyline up to and including column i
!
        icol(1)=0
        do i=2,neq
          jq(i)=ipointer(i)
          icol(i)=icol(i-1)+i-jq(i)
        enddo
        nsky=icol(neq)
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'total length of the skyline'
        write(*,*) icol(neq)
        write(*,*)
!
      else
!
!     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
!
        do i=1,3*nk
          ipointer(i)=0
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 call insert(ipointer,mast1,irow,
     &                       jdof1,jdof2,ifree,nzs_)
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                          call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       ordering the nonzero nodes in the SUPERdiagonal columns
!       mast1 contains the row numbers column per column,
!       irow the column numbers
!
        do i=1,neq
          itot=0
          if(ipointer(i).eq.0) then
            write(*,*) 'error in mastruct: zero column'
            stop
          endif
          istart=ipointer(i)
          do
            itot=itot+1
            ikcol(itot)=mast1(istart)
            istart=irow(istart)
            if(istart.eq.0) exit
          enddo
          call isortii(ikcol,icol,itot,kflag)
          istart=ipointer(i)
          do j=1,itot-1
            mast1(istart)=ikcol(j)
            istartold=istart
            istart=irow(istart)
            irow(istartold)=i
          enddo
          mast1(istart)=ikcol(itot)
          irow(istart)=i
        enddo
!
!       defining icol and jq
!
        nsky=0
	nsky_exp=0
        do i=2,neq
          nsky_inc=i-mast1(ipointer(i))
          if(2147483647-nsky.lt.nsky_inc) then
	     nsky_exp=nsky_exp+1
	     nsky_inc=nsky_inc-2147483647
	  endif
	  nsky=nsky+nsky_inc
        enddo
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'number of nonzero matrix elements'
        write(*,*) ifree
        write(*,*) 'total length of the skyline'
        write(*,*) nsky_exp,'*2147483647+',nsky
        write(*,*) 'percentage of nonzero skyline elements'
        write(*,*) real(ifree)/
     &     (real(nsky+neq)+nsky_exp*real(2147483647))*100.
        write(*,*)
!
!       new meaning of icol,j1,mast1,irow:
!       - irow is going to contain the row numbers of the SUBdiagonal
!         nonzero's, column per column
!       - mast1 contains the column numbers
!       - icol(i)=# SUBdiagonal nonzero's in column i
!       - jq(i)= location in field irow of the first SUBdiagonal
!         nonzero in column i
!
        nmast=ifree
!
!       switching from a SUPERdiagonal inventary to a SUBdiagonal one
!
        call isortii(mast1,irow,nmast,kflag)
!
!       filtering out the diagonal elements and generating icol and jq
!
        isubtract=0
        do i=1,neq
           icol(i)=0
        enddo
        k=0
        do i=1,nmast
           if(mast1(i).eq.irow(i)) then
              isubtract=isubtract+1
           else
              mast1(i-isubtract)=mast1(i)
              irow(i-isubtract)=irow(i)
              if(k.ne.mast1(i)) then
                 do l=k+1,mast1(i)
                    jq(l)=i-isubtract
                 enddo
                 k=mast1(i)
              endif
              icol(k)=icol(k)+1
           endif
        enddo
        nmast=nmast-isubtract
        do l=k+1,neq+1
           jq(l)=nmast+1
        enddo
!
        do i=1,neq
           if(jq(i+1)-jq(i).gt.0) then
              call isortii(irow(jq(i)),mast1(jq(i)),jq(i+1)-jq(i),
     &          kflag)

           endif
        enddo
!
        nzs=jq(neq)-1
!
      endif
!
      return
      end

      */

invivomastruct_mastruct_615

Real time: 4.825128e+06 -- Predicted time: 4.780256e+06

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	4.780256e+06	4.786612e+06	0.1

                /*     CalculiX - A 3-dimensional finite element program                 */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                                                                       */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdlib.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "CalculiX.h"

#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))

void mastruct(int *nk, int *kon, int *ipkon, char *lakon, int *ne,
	      int *nodeboun, int *ndirboun, int *nboun, int *ipompc,
	      int *nodempc, int *nmpc, int *nactdof, int *icol,
	      int *jq, int **mast1p, int **irowp, int *isolver, int *neq,
	      int *nnn, int *ikmpc, int *ilmpc, int *ikcol,
	      int *ipointer, int *nsky, int *nzs, int *nmethod,
              int *ithermal){

  int 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,itot,
    index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
    *irow=NULL,nsky_exp,nsky_inc;

  /* the indices in the comments follow FORTRAN convention, i.e. the
     fields start with 1 */

  mast1=*mast1p;
  irow=*irowp;

  kflag=2;
  nzs_=*nzs;

  /* initialisation of nactmpc */

  for(i=0;i<4**nk;++i){nactdof[i]=0;}

  /* determining the mechanical active degrees of freedom due to elements */

  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      for(k=1;k<4;++k){
		  nactdof[4*node+k]=1;
	      }
	  }
      }
  }

  /* determining the thermal active degrees of freedom due to elements */

  if(*ithermal>1){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      nactdof[4*node]=1;
	  }
      }
  }

  /* determining the active degrees of freedom due to mpc's */

  for(i=0;i<*nmpc;++i){
      index=ipompc[i]-1;
      do{
	  nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=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]>3){continue;}
      nactdof[4*(nodeboun[i]-1)+ndirboun[i]]=0;
  }

  for(i=0;i<*nmpc;++i){
    index=ipompc[i]-1;
    nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=0;
  }
  
  /* numbering the active degrees of freedom */
  
  *neq=0;
  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*nk;++i){
	  for(j=1;j<4;++j){
	      if(nactdof[4*nnn[i]+j-4]!=0){
		  ++*neq;
		  nactdof[4*nnn[i]+j-4]=*neq;
	      }
	  }
      }
  }
  if(*ithermal>1){
      for(i=0;i<*nk;++i){
	  if(nactdof[4*nnn[i]-4]!=0){
	      ++*neq;
	      nactdof[4*nnn[i]-4]=*neq;
	  }
      }
  }
  
  ifree=0;
  
  /* determining the position of the skyline only */
  
  if(*isolver==1){
    
    /* ipointer(i) = first nonzero row number in column i */
    
    for(i=0;i<4**nk;++i){ipointer[i]=i+1;}
    
    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-1)+m+1];
	  
	  /* check whether one of the DOF belongs to a SPC or MPC */
	  
	  if((jdof1!=0)&&(jdof2!=0)){
	    ipointer[max(jdof1,jdof2)-1]=
	      min(ipointer[max(jdof1,jdof2)-1],min(jdof1,jdof2));
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    ipointer[max(idof1,idof2)-1]=
		      min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }
    
    /* defining icol and jq
       
       jq(i) = first nonzero row element in column i
       icol(i) = length of skyline up to and including column i */
    
    icol[0]=0;
    for(i=1;i<*neq;++i){
      jq[i]=ipointer[i];
      icol[i]=icol[i-1]+i-jq[i]+1;
    }
    *nsky=icol[*neq-1];

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("total length of the skyline\n");
    printf("%d\n\n",icol[*neq-1]);
    
  }
  else{

    /* 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<4**nk;++i){ipointer[i]=0;}

    /* mechanical entries */
    
    if((*ithermal<2)||(*ithermal==3)){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }

    /* thermal entries*/

    if(*ithermal>1){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<nope;++jj){
	
	j=jj;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)];
	
	for(ll=jj;ll<nope;++ll){
	  
	  l=ll;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1-7;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2-7;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1-7;
	    idof2=7*node2-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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }
    
    /* 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;++i){
      itot=0;
      if(ipointer[i]==0){
	printf("error in mastruct: zero column\n");
	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;
    }

    /* definiing icol and jq */

    *nsky=0;
    nsky_exp=0;
    for(i=1;i<*neq;++i){
      nsky_inc=i+1-mast1[ipointer[i]-1];
      if(2147483647-*nsky<nsky_inc){
	++nsky_exp;
	nsky_inc=nsky_inc-2147483647;
      }
      *nsky=*nsky+nsky_inc;
    }

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("number of nonzero matrix elements\n");
    printf("%d\n",ifree);
    printf("total length of the skyline\n");
    printf("%d*2147483647+%d\n",nsky_exp,*nsky);
    printf("percentage of nonzero skyline elements\n");
    printf("%f\n\n",((double)ifree)/
	   ((double)(*nsky+*neq)+nsky_exp*(double)(2147483647))*100.);

    /* new meaning of icol,j1,mast1,irow:

       - irow is going to contain the row numbers of the SUBdiagonal
         nonzero's, column per column
       - mast1 contains the column numbers
       - icol(i)=# SUBdiagonal nonzero's in column i
       - jq(i)= location in field irow of the first SUBdiagonal
         nonzero in column i

	 */

    nmast=ifree;

    /* switching from a SUPERdiagonal inventory to a SUBdiagonal one */

    FORTRAN(isortii,(mast1,irow,&nmast,&kflag));
    
    /* filtering out the diagonal elements and generating icol and jq */

    isubtract=0;
    for(i=1;i<*neq;++i){icol[i]=0;}
    k=0;
    for(i=0;i<nmast;++i){
      if(mast1[i]==irow[i]){++isubtract;}
      else{
	mast1[i-isubtract]=mast1[i];
	irow[i-isubtract]=irow[i];
	if(k!=mast1[i]){
	  for(l=k;l<mast1[i];++l){jq[l]=i+1-isubtract;}
	  k=mast1[i];
	}
	++icol[k-1];
      }
    }
    nmast=nmast-isubtract;
    for(l=k;l<*neq+1;++l){jq[l]=nmast+1;}

    for(i=0;i<*neq;++i){
      if(jq[i+1]-jq[i]>0){
	isize=jq[i+1]-jq[i];
	FORTRAN(isortii,(&irow[jq[i]-1],&mast1[jq[i]-1],&isize,&kflag));
      }
    }

    *nzs=jq[*neq-1]-1;

  }

  *mast1p=mast1;
  *irowp=irow;

  return;

}
	  
/*

What follows is the original FORTRAN code. The C Code is a one-to-one
manual translation of the FORTRAN code. However, the FORTRAN code might
be easier to understand.

!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
     &  nboun,ipompc,
     &  nodempc,nmpc,nactdof,icol,jq,mast1,irow,isolver,neq,nnn,
     &  ikmpc,ilmpc,ikcol,ipointer,nsky,nzs,nmethod)
!
      implicit none
!
      character*6 lakon(*)
!
      integer kon(*),nodeboun(*),ndirboun(*),nodempc(3,*),ipompc(*),
     &  nactdof(3,*),icol(*),jq(*),ipointer(*),nnn(*),ikmpc(*),ilmpc(*),
     &  ikcol(*),mast1(*),irow(*),ipkon(*)
!
      integer nk,ne,nboun,nmpc,isolver,neq,nsky,nzs,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,itot,index1,index2,
     &  m,node,nzs_,ist,kflag,nmethod,indexe,nope,nsky_exp,nsky_inc
!
      kflag=2
      nzs_=nzs
!
!     initialisation of nactmpc
!
      do i=1,nk
        do j=1,3
          nactdof(j,i)=0
        enddo
      enddo
!
!     determining the active degrees of freedom due to elements
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
            nope=20
         elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
            nope=8
         else
            nope=10
         endif
!
         do j=1,nope
            node=kon(indexe+j)
            do k=1,3
               nactdof(k,node)=1
            enddo
         enddo
      enddo
!
!     determining the active degrees of freedom due to mpc's
!
      do i=1,nmpc
         index=ipompc(i)
         do
            nactdof(nodempc(2,index),nodempc(1,index))=1
            index=nodempc(3,index)
	    if(index.eq.0) exit
	 enddo
      enddo
!      
!     subtracting the SPC and MPC nodes
!
      do i=1,nboun
        nactdof(ndirboun(i),nodeboun(i))=0
      enddo
!
      do i=1,nmpc
         index=ipompc(i)
         nactdof(nodempc(2,index),nodempc(1,index))=0
      enddo
!
!     numbering the active degrees of freedom
!
      neq=0
      do i=1,nk
        do j=1,3
          if(nactdof(j,nnn(i)).ne.0) then
            neq=neq+1
            nactdof(j,nnn(i))=neq
          endif
        enddo
      enddo
!
      ifree=0
!
!     determining the position of the skyline only
!
      if(isolver.eq.1) then
!
!       ipointer(i) = first nonzero row number in column i
!
        do i=1,3*nk
          ipointer(i)=i
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 ipointer(max(jdof1,jdof2))=
     &             min(ipointer(max(jdof1,jdof2)),min(jdof1,jdof2))
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       defining icol and jq
!
!       jq(i) = first nonzero row element in column i
!       icol(i) = length of skyline up to and including column i
!
        icol(1)=0
        do i=2,neq
          jq(i)=ipointer(i)
          icol(i)=icol(i-1)+i-jq(i)
        enddo
        nsky=icol(neq)
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'total length of the skyline'
        write(*,*) icol(neq)
        write(*,*)
!
      else
!
!     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
!
        do i=1,3*nk
          ipointer(i)=0
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 call insert(ipointer,mast1,irow,
     &                       jdof1,jdof2,ifree,nzs_)
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                          call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       ordering the nonzero nodes in the SUPERdiagonal columns
!       mast1 contains the row numbers column per column,
!       irow the column numbers
!
        do i=1,neq
          itot=0
          if(ipointer(i).eq.0) then
            write(*,*) 'error in mastruct: zero column'
            stop
          endif
          istart=ipointer(i)
          do
            itot=itot+1
            ikcol(itot)=mast1(istart)
            istart=irow(istart)
            if(istart.eq.0) exit
          enddo
          call isortii(ikcol,icol,itot,kflag)
          istart=ipointer(i)
          do j=1,itot-1
            mast1(istart)=ikcol(j)
            istartold=istart
            istart=irow(istart)
            irow(istartold)=i
          enddo
          mast1(istart)=ikcol(itot)
          irow(istart)=i
        enddo
!
!       defining icol and jq
!
        nsky=0
	nsky_exp=0
        do i=2,neq
          nsky_inc=i-mast1(ipointer(i))
          if(2147483647-nsky.lt.nsky_inc) then
	     nsky_exp=nsky_exp+1
	     nsky_inc=nsky_inc-2147483647
	  endif
	  nsky=nsky+nsky_inc
        enddo
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'number of nonzero matrix elements'
        write(*,*) ifree
        write(*,*) 'total length of the skyline'
        write(*,*) nsky_exp,'*2147483647+',nsky
        write(*,*) 'percentage of nonzero skyline elements'
        write(*,*) real(ifree)/
     &     (real(nsky+neq)+nsky_exp*real(2147483647))*100.
        write(*,*)
!
!       new meaning of icol,j1,mast1,irow:
!       - irow is going to contain the row numbers of the SUBdiagonal
!         nonzero's, column per column
!       - mast1 contains the column numbers
!       - icol(i)=# SUBdiagonal nonzero's in column i
!       - jq(i)= location in field irow of the first SUBdiagonal
!         nonzero in column i
!
        nmast=ifree
!
!       switching from a SUPERdiagonal inventary to a SUBdiagonal one
!
        call isortii(mast1,irow,nmast,kflag)
!
!       filtering out the diagonal elements and generating icol and jq
!
        isubtract=0
        do i=1,neq
           icol(i)=0
        enddo
        k=0
        do i=1,nmast
           if(mast1(i).eq.irow(i)) then
              isubtract=isubtract+1
           else
              mast1(i-isubtract)=mast1(i)
              irow(i-isubtract)=irow(i)
              if(k.ne.mast1(i)) then
                 do l=k+1,mast1(i)
                    jq(l)=i-isubtract
                 enddo
                 k=mast1(i)
              endif
              icol(k)=icol(k)+1
           endif
        enddo
        nmast=nmast-isubtract
        do l=k+1,neq+1
           jq(l)=nmast+1
        enddo
!
        do i=1,neq
           if(jq(i+1)-jq(i).gt.0) then
              call isortii(irow(jq(i)),mast1(jq(i)),jq(i+1)-jq(i),
     &          kflag)

           endif
        enddo
!
        nzs=jq(neq)-1
!
      endif
!
      return
      end

      */

invivomastruct_mastruct_331

Real time: 1.939523e+07 -- Predicted time: 1.919306e+07

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	1.919306e+07	1.953532e+07	1.7

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_DV_DVdot33_1241

Real time: 3.388256e+06 -- Predicted time: 7.024252e+06

Callcount: 7920

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1054	### 1	1004.93464052288	1.065000e+03	6.120000e+02	42.5
6	### 2	1025.04587155963	9.890000e+02	4.360000e+02	55.9
14	### 3	446.889830508475	1.072000e+03	4.720000e+02	55.9
7	### 4	693.803571428571	8.630000e+02	4.480000e+02	48.0
644	### 5	812.237037037037	8.410000e+02	5.400000e+02	35.7
2944	### 6	410.880681818182	1.030000e+03	7.040000e+02	31.6
1410	### 7	1474.89655172414	6.930000e+02	3.480000e+02	49.7
1308	### 8	1410.60784313725	7.960000e+02	2.040000e+02	74.3
5547	### 9	670.869791666667	9.110000e+02	7.680000e+02	15.6

                /*     CalculiX - A 3-dimensional finite element program                 */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                                                                       */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdlib.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "CalculiX.h"

#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))

void mastruct(int *nk, int *kon, int *ipkon, char *lakon, int *ne,
	      int *nodeboun, int *ndirboun, int *nboun, int *ipompc,
	      int *nodempc, int *nmpc, int *nactdof, int *icol,
	      int *jq, int **mast1p, int **irowp, int *isolver, int *neq,
	      int *nnn, int *ikmpc, int *ilmpc, int *ikcol,
	      int *ipointer, int *nsky, int *nzs, int *nmethod,
              int *ithermal){

  int 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,itot,
    index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
    *irow=NULL,nsky_exp,nsky_inc;

  /* the indices in the comments follow FORTRAN convention, i.e. the
     fields start with 1 */

  mast1=*mast1p;
  irow=*irowp;

  kflag=2;
  nzs_=*nzs;

  /* initialisation of nactmpc */

  for(i=0;i<4**nk;++i){nactdof[i]=0;}

  /* determining the mechanical active degrees of freedom due to elements */

  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      for(k=1;k<4;++k){
		  nactdof[4*node+k]=1;
	      }
	  }
      }
  }

  /* determining the thermal active degrees of freedom due to elements */

  if(*ithermal>1){
      for(i=0;i<*ne;++i){
	  
	  if(ipkon[i]<0) continue;
	  indexe=ipkon[i];
	  if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
	  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 {nope=6;}
	  
	  for(j=0;j<nope;++j){
	      node=kon[indexe+j]-1;
	      nactdof[4*node]=1;
	  }
      }
  }

  /* determining the active degrees of freedom due to mpc's */

  for(i=0;i<*nmpc;++i){
      index=ipompc[i]-1;
      do{
	  nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=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]>3){continue;}
      nactdof[4*(nodeboun[i]-1)+ndirboun[i]]=0;
  }

  for(i=0;i<*nmpc;++i){
    index=ipompc[i]-1;
    nactdof[4*nodempc[3*index]+nodempc[3*index+1]-4]=0;
  }
  
  /* numbering the active degrees of freedom */
  
  *neq=0;
  if((*ithermal<2)||(*ithermal==3)){
      for(i=0;i<*nk;++i){
	  for(j=1;j<4;++j){
	      if(nactdof[4*nnn[i]+j-4]!=0){
		  ++*neq;
		  nactdof[4*nnn[i]+j-4]=*neq;
	      }
	  }
      }
  }
  if(*ithermal>1){
      for(i=0;i<*nk;++i){
	  if(nactdof[4*nnn[i]-4]!=0){
	      ++*neq;
	      nactdof[4*nnn[i]-4]=*neq;
	  }
      }
  }
  
  ifree=0;
  
  /* determining the position of the skyline only */
  
  if(*isolver==1){
    
    /* ipointer(i) = first nonzero row number in column i */
    
    for(i=0;i<4**nk;++i){ipointer[i]=i+1;}
    
    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-1)+m+1];
	  
	  /* check whether one of the DOF belongs to a SPC or MPC */
	  
	  if((jdof1!=0)&&(jdof2!=0)){
	    ipointer[max(jdof1,jdof2)-1]=
	      min(ipointer[max(jdof1,jdof2)-1],min(jdof1,jdof2));
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    ipointer[max(idof1,idof2)-1]=
		      min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      ipointer[max(idof1,idof2)-1]=
			min(ipointer[max(idof1,idof2)-1],min(idof1,idof2));}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }
    
    /* defining icol and jq
       
       jq(i) = first nonzero row element in column i
       icol(i) = length of skyline up to and including column i */
    
    icol[0]=0;
    for(i=1;i<*neq;++i){
      jq[i]=ipointer[i];
      icol[i]=icol[i-1]+i-jq[i]+1;
    }
    *nsky=icol[*neq-1];

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("total length of the skyline\n");
    printf("%d\n\n",icol[*neq-1]);
    
  }
  else{

    /* 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<4**nk;++i){ipointer[i]=0;}

    /* mechanical entries */
    
    if((*ithermal<2)||(*ithermal==3)){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<3*nope;++jj){
	
	j=jj/3;
	k=jj-3*j;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)+k+1];
	
	for(ll=jj;ll<3*nope;++ll){
	  
	  l=ll/3;
	  m=ll-3*l;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1+k-6;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2+m-6;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1+k-6;
	    idof2=7*node2+m-6;
	    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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }

    /* thermal entries*/

    if(*ithermal>1){

    for(i=0;i<*ne;++i){
      
      if(ipkon[i]<0) continue;
      indexe=ipkon[i];
      if(strcmp1(&lakon[8*i+3],"2")==0)nope=20;
      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 {nope=6;}
      
      for(jj=0;jj<nope;++jj){
	
	j=jj;
	
	node1=kon[indexe+j];
	jdof1=nactdof[4*(node1-1)];
	
	for(ll=jj;ll<nope;++ll){
	  
	  l=ll;
	  
	  node2=kon[indexe+l];
	  jdof2=nactdof[4*(node2-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_);
	  }
	  else if((jdof1!=0)||(jdof2!=0)){
	    
	    /* idof1: genuine DOF
	       idof2: nominal DOF of the SPC/MPC */
	    
	    if(jdof1==0){
	      idof1=jdof2;
	      idof2=7*node1-7;}
	    else{
	      idof1=jdof1;
	      idof2=7*node2-7;}
	    
	    if(*nmpc>0){
	      
	      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
	      if((id>0)&&(ikmpc[id-1]==idof2)){
		
		/* regular DOF / MPC */
		
		id=ilmpc[id-1];
		ist=ipompc[id-1];
		index=nodempc[3*ist-1];
		if(index==0) continue;
		while(1){
		  idof2=nactdof[4*nodempc[3*index-3]+nodempc[3*index-2]-4];
		  if(idof2!=0){
		    insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);
		  }
		  index=nodempc[3*index-1];
		  if(index==0) break;
		}
		continue;
	      }
	    }
	  }
	  
	  else{
	    idof1=7*node1-7;
	    idof2=7*node2-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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  index2=index1;
		  while(1){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&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){
		  idof1=nactdof[4*nodempc[3*index1-3]+nodempc[3*index1-2]-4];
		  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){
		    idof2=nactdof[4*nodempc[3*index2-3]+nodempc[3*index2-2]-4];
		    if((idof1!=0)&&(idof2!=0)){
		      insert(ipointer,&mast1,&irow,&idof1,&idof2,&ifree,&nzs_);}
		    index2=nodempc[3*index2-1];
		    if(index2==0) break;
		  }
		  index1=nodempc[3*index1-1];
		  if(index1==0) break;
		}
	      }
	    }
	  }
	}
      }
    }

    }
    
    /* 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;++i){
      itot=0;
      if(ipointer[i]==0){
	printf("error in mastruct: zero column\n");
	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;
    }

    /* definiing icol and jq */

    *nsky=0;
    nsky_exp=0;
    for(i=1;i<*neq;++i){
      nsky_inc=i+1-mast1[ipointer[i]-1];
      if(2147483647-*nsky<nsky_inc){
	++nsky_exp;
	nsky_inc=nsky_inc-2147483647;
      }
      *nsky=*nsky+nsky_inc;
    }

    if(*neq==0){
      printf("*ERROR: no degrees of freedom in the model\n");
      FORTRAN(stop,());
    }

    printf("number of equations\n");
    printf("%d\n",*neq);
    printf("number of nonzero matrix elements\n");
    printf("%d\n",ifree);
    printf("total length of the skyline\n");
    printf("%d*2147483647+%d\n",nsky_exp,*nsky);
    printf("percentage of nonzero skyline elements\n");
    printf("%f\n\n",((double)ifree)/
	   ((double)(*nsky+*neq)+nsky_exp*(double)(2147483647))*100.);

    /* new meaning of icol,j1,mast1,irow:

       - irow is going to contain the row numbers of the SUBdiagonal
         nonzero's, column per column
       - mast1 contains the column numbers
       - icol(i)=# SUBdiagonal nonzero's in column i
       - jq(i)= location in field irow of the first SUBdiagonal
         nonzero in column i

	 */

    nmast=ifree;

    /* switching from a SUPERdiagonal inventory to a SUBdiagonal one */

    FORTRAN(isortii,(mast1,irow,&nmast,&kflag));
    
    /* filtering out the diagonal elements and generating icol and jq */

    isubtract=0;
    for(i=1;i<*neq;++i){icol[i]=0;}
    k=0;
    for(i=0;i<nmast;++i){
      if(mast1[i]==irow[i]){++isubtract;}
      else{
	mast1[i-isubtract]=mast1[i];
	irow[i-isubtract]=irow[i];
	if(k!=mast1[i]){
	  for(l=k;l<mast1[i];++l){jq[l]=i+1-isubtract;}
	  k=mast1[i];
	}
	++icol[k-1];
      }
    }
    nmast=nmast-isubtract;
    for(l=k;l<*neq+1;++l){jq[l]=nmast+1;}

    for(i=0;i<*neq;++i){
      if(jq[i+1]-jq[i]>0){
	isize=jq[i+1]-jq[i];
	FORTRAN(isortii,(&irow[jq[i]-1],&mast1[jq[i]-1],&isize,&kflag));
      }
    }

    *nzs=jq[*neq-1]-1;

  }

  *mast1p=mast1;
  *irowp=irow;

  return;

}
	  
/*

What follows is the original FORTRAN code. The C Code is a one-to-one
manual translation of the FORTRAN code. However, the FORTRAN code might
be easier to understand.

!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
     &  nboun,ipompc,
     &  nodempc,nmpc,nactdof,icol,jq,mast1,irow,isolver,neq,nnn,
     &  ikmpc,ilmpc,ikcol,ipointer,nsky,nzs,nmethod)
!
      implicit none
!
      character*6 lakon(*)
!
      integer kon(*),nodeboun(*),ndirboun(*),nodempc(3,*),ipompc(*),
     &  nactdof(3,*),icol(*),jq(*),ipointer(*),nnn(*),ikmpc(*),ilmpc(*),
     &  ikcol(*),mast1(*),irow(*),ipkon(*)
!
      integer nk,ne,nboun,nmpc,isolver,neq,nsky,nzs,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,itot,index1,index2,
     &  m,node,nzs_,ist,kflag,nmethod,indexe,nope,nsky_exp,nsky_inc
!
      kflag=2
      nzs_=nzs
!
!     initialisation of nactmpc
!
      do i=1,nk
        do j=1,3
          nactdof(j,i)=0
        enddo
      enddo
!
!     determining the active degrees of freedom due to elements
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
            nope=20
         elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
            nope=8
         else
            nope=10
         endif
!
         do j=1,nope
            node=kon(indexe+j)
            do k=1,3
               nactdof(k,node)=1
            enddo
         enddo
      enddo
!
!     determining the active degrees of freedom due to mpc's
!
      do i=1,nmpc
         index=ipompc(i)
         do
            nactdof(nodempc(2,index),nodempc(1,index))=1
            index=nodempc(3,index)
	    if(index.eq.0) exit
	 enddo
      enddo
!      
!     subtracting the SPC and MPC nodes
!
      do i=1,nboun
        nactdof(ndirboun(i),nodeboun(i))=0
      enddo
!
      do i=1,nmpc
         index=ipompc(i)
         nactdof(nodempc(2,index),nodempc(1,index))=0
      enddo
!
!     numbering the active degrees of freedom
!
      neq=0
      do i=1,nk
        do j=1,3
          if(nactdof(j,nnn(i)).ne.0) then
            neq=neq+1
            nactdof(j,nnn(i))=neq
          endif
        enddo
      enddo
!
      ifree=0
!
!     determining the position of the skyline only
!
      if(isolver.eq.1) then
!
!       ipointer(i) = first nonzero row number in column i
!
        do i=1,3*nk
          ipointer(i)=i
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 ipointer(max(jdof1,jdof2))=
     &             min(ipointer(max(jdof1,jdof2)),min(jdof1,jdof2))
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         ipointer(max(idof1,idof2))=
     &                         min(ipointer(max(idof1,idof2)),
     &                             min(idof1,idof2))
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       defining icol and jq
!
!       jq(i) = first nonzero row element in column i
!       icol(i) = length of skyline up to and including column i
!
        icol(1)=0
        do i=2,neq
          jq(i)=ipointer(i)
          icol(i)=icol(i-1)+i-jq(i)
        enddo
        nsky=icol(neq)
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'total length of the skyline'
        write(*,*) icol(neq)
        write(*,*)
!
      else
!
!     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
!
        do i=1,3*nk
          ipointer(i)=0
        enddo
!
        do i=1,ne
!
          if(ipkon(i).lt.0) cycle
          indexe=ipkon(i)
          if((lakon(i).eq.'C3D20R').or.(lakon(i).eq.'C3D20 ')) then
             nope=20
          elseif((lakon(i).eq.'C3D8R ').or.(lakon(i).eq.'C3D8  ')) then
             nope=8
          else
             nope=10
          endif
!
          do jj=1,3*nope
!
            j=(jj-1)/3+1
            k=jj-3*(j-1)
!
            node1=kon(indexe+j)
            jdof1=nactdof(k,node1)
!
            do ll=jj,3*nope
!
              l=(ll-1)/3+1
              m=ll-3*(l-1)
!
              node2=kon(indexe+l)
              jdof2=nactdof(m,node2)
!
!             check whether one of the DOF belongs to a SPC or MPC
!
              if((jdof1.ne.0).and.(jdof2.ne.0)) then
                 call insert(ipointer,mast1,irow,
     &                       jdof1,jdof2,ifree,nzs_)
              elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
                 if(jdof1.eq.0) then
                    idof1=jdof2
                    idof2=(node1-1)*3+k
                 else
                    idof1=jdof1
                    idof2=(node2-1)*3+m
                 endif
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof2,nmpc,id)
                    if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                       id=ilmpc(id)
                       ist=ipompc(id)
                       index=nodempc(3,ist)
		       if(index.eq.0) cycle
                       do
                          idof2=nactdof(nodempc(2,index),
     &                                  nodempc(1,index))
                          if(idof2.ne.0) then
                             call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                          endif
                          index=nodempc(3,index)
                          if(index.eq.0) exit
                       enddo
                       cycle
                    endif
                 endif
!
              else
                 idof1=(node1-1)*3+k
                 idof2=(node2-1)*3+m
                 mpc1=0
                 mpc2=0
                 if(nmpc.gt.0) then
                    call nident(ikmpc,idof1,nmpc,id1)
                    if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                    call nident(ikmpc,idof2,nmpc,id2)
                    if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
                 endif
                 if((mpc1.eq.1).and.(mpc2.eq.1)) then
                    id1=ilmpc(id1)
                    id2=ilmpc(id2)
                    if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                       ist=ipompc(id1)
                       index1=nodempc(3,ist)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          index2=index1
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                         call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                     else
!
!                    MPC id1 / MPC id2
!
                       ist1=ipompc(id1)
                       index1=nodempc(3,ist1)
		       if(index1.eq.0) cycle
                       do
                          idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                          ist2=ipompc(id2)
                          index2=nodempc(3,ist2)
                          if(index2.eq.0) then
                             index1=nodempc(3,index1)
                             if(index1.eq.0) then
                                exit
                             else
                                cycle
                             endif
                          endif
                          do
                             idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                             if((idof1.ne.0).and.(idof2.ne.0))
     &                          call insert(ipointer,mast1,irow,
     &                                   idof1,idof2,ifree,nzs_)
                             index2=nodempc(3,index2)
                             if(index2.eq.0) exit
                          enddo
                          index1=nodempc(3,index1)
                          if(index1.eq.0) exit
                       enddo
                    endif
                 endif
              endif
            enddo
          enddo
        enddo
!
!       ordering the nonzero nodes in the SUPERdiagonal columns
!       mast1 contains the row numbers column per column,
!       irow the column numbers
!
        do i=1,neq
          itot=0
          if(ipointer(i).eq.0) then
            write(*,*) 'error in mastruct: zero column'
            stop
          endif
          istart=ipointer(i)
          do
            itot=itot+1
            ikcol(itot)=mast1(istart)
            istart=irow(istart)
            if(istart.eq.0) exit
          enddo
          call isortii(ikcol,icol,itot,kflag)
          istart=ipointer(i)
          do j=1,itot-1
            mast1(istart)=ikcol(j)
            istartold=istart
            istart=irow(istart)
            irow(istartold)=i
          enddo
          mast1(istart)=ikcol(itot)
          irow(istart)=i
        enddo
!
!       defining icol and jq
!
        nsky=0
	nsky_exp=0
        do i=2,neq
          nsky_inc=i-mast1(ipointer(i))
          if(2147483647-nsky.lt.nsky_inc) then
	     nsky_exp=nsky_exp+1
	     nsky_inc=nsky_inc-2147483647
	  endif
	  nsky=nsky+nsky_inc
        enddo
!
        write(*,*) 'number of equations'
        write(*,*) neq
        write(*,*) 'number of nonzero matrix elements'
        write(*,*) ifree
        write(*,*) 'total length of the skyline'
        write(*,*) nsky_exp,'*2147483647+',nsky
        write(*,*) 'percentage of nonzero skyline elements'
        write(*,*) real(ifree)/
     &     (real(nsky+neq)+nsky_exp*real(2147483647))*100.
        write(*,*)
!
!       new meaning of icol,j1,mast1,irow:
!       - irow is going to contain the row numbers of the SUBdiagonal
!         nonzero's, column per column
!       - mast1 contains the column numbers
!       - icol(i)=# SUBdiagonal nonzero's in column i
!       - jq(i)= location in field irow of the first SUBdiagonal
!         nonzero in column i
!
        nmast=ifree
!
!       switching from a SUPERdiagonal inventary to a SUBdiagonal one
!
        call isortii(mast1,irow,nmast,kflag)
!
!       filtering out the diagonal elements and generating icol and jq
!
        isubtract=0
        do i=1,neq
           icol(i)=0
        enddo
        k=0
        do i=1,nmast
           if(mast1(i).eq.irow(i)) then
              isubtract=isubtract+1
           else
              mast1(i-isubtract)=mast1(i)
              irow(i-isubtract)=irow(i)
              if(k.ne.mast1(i)) then
                 do l=k+1,mast1(i)
                    jq(l)=i-isubtract
                 enddo
                 k=mast1(i)
              endif
              icol(k)=icol(k)+1
           endif
        enddo
        nmast=nmast-isubtract
        do l=k+1,neq+1
           jq(l)=nmast+1
        enddo
!
        do i=1,neq
           if(jq(i+1)-jq(i).gt.0) then
              call isortii(irow(jq(i)),mast1(jq(i)),jq(i+1)-jq(i),
     &          kflag)

           endif
        enddo
!
        nzs=jq(neq)-1
!
      endif
!
      return
      end

      */

invivomastruct_mastruct_705

Real time: 4.270208e+06 -- Predicted time: 4.277338e+06

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	4.277338e+06	4.278852e+06	0.0

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_newsort_IVqsortUp_975

Real time: 1.825840e+06 -- Predicted time: 1.007780e+07

Callcount: 12588

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
351	### 1	3448.46031746032	9.540000e+02	2.520000e+02	73.5
33	### 2	9311.34482758621	7.290000e+02	1.160000e+02	84.0

                *DECK ISORT
      SUBROUTINE ISORTII (IX, IY, N, KFLAG)
C***BEGIN PROLOGUE  ISORT
C***PURPOSE  Sort an array and optionally make the same interchanges in
C            an auxiliary array.  The array may be sorted in increasing
C            or decreasing order.  A slightly modified QUICKSORT
C            algorithm is used.
C***LIBRARY   SLATEC
C***CATEGORY  N6A2A
C***TYPE      INTEGER (SSORT-S, DSORT-D, ISORT-I)
C***KEYWORDS  SINGLETON QUICKSORT, SORT, SORTING
C***AUTHOR  Jones, R. E., (SNLA)
C           Kahaner, D. K., (NBS)
C           Wisniewski, J. A., (SNLA)
C***DESCRIPTION
C
C   ISORT sorts array IX and optionally makes the same interchanges in
C   array IY.  The array IX may be sorted in increasing order or
C   decreasing order.  A slightly modified quicksort algorithm is used.
C
C   Description of Parameters
C      IX - integer array of values to be sorted
C      IY - integer array to be (optionally) carried along
C      N  - number of values in integer array IX to be sorted
C      KFLAG - control parameter
C            =  2  means sort IX in increasing order and carry IY along.
C            =  1  means sort IX in increasing order (ignoring IY)
C            = -1  means sort IX in decreasing order (ignoring IY)
C            = -2  means sort IX in decreasing order and carry IY along.
C
C***REFERENCES  R. C. Singleton, Algorithm 347, An efficient algorithm
C                 for sorting with minimal storage, Communications of
C                 the ACM, 12, 3 (1969), pp. 185-187.
C***ROUTINES CALLED  XERMSG
C***REVISION HISTORY  (YYMMDD)
C   761118  DATE WRITTEN
C   810801  Modified by David K. Kahaner.
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890831  Modified array declarations.  (WRB)
C   891009  Removed unreferenced statement labels.  (WRB)
C   891009  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   901012  Declared all variables; changed X,Y to IX,IY. (M. McClain)
C   920501  Reformatted the REFERENCES section.  (DWL, WRB)
C   920519  Clarified error messages.  (DWL)
C   920801  Declarations section rebuilt and code restructured to use
C           IF-THEN-ELSE-ENDIF.  (RWC, WRB)
C***END PROLOGUE  ISORT
C     .. Scalar Arguments ..
      INTEGER KFLAG, N
C     .. Array Arguments ..
      INTEGER IX(*), IY(*)
C     .. Local Scalars ..
      REAL R
      INTEGER I, IJ, J, K, KK, L, M, NN, T, TT, TTY, TY
C     .. Local Arrays ..
      INTEGER IL(21), IU(21)
C     .. External Subroutines ..
!      EXTERNAL XERMSG
C     .. Intrinsic Functions ..
      INTRINSIC ABS, INT
C***FIRST EXECUTABLE STATEMENT  ISORT
      NN = N
      IF (NN .LT. 1) THEN
!         CALL XERMSG ('SLATEC', 'ISORT',
!     +      'The number of values to be sorted is not positive.', 1, 1)
         RETURN
      ENDIF
C
      KK = ABS(KFLAG)
      IF (KK.NE.1 .AND. KK.NE.2) THEN
!         CALL XERMSG ('SLATEC', 'ISORT',
!     +      'The sort control parameter, K, is not 2, 1, -1, or -2.', 2,
!     +      1)
         RETURN
      ENDIF
C
C     Alter array IX to get decreasing order if needed
C
      IF (KFLAGS .LE. -1) THEN
         DO 10 I=1,NN
            IX(I) = -IX(I)
   10    CONTINUE
      ENDIF
C
      IF (KK .EQ. 2) GO TO 100
C
C     Sort IX only
C
      M = 1
      I = 1
      J = NN
      R = 0.375E0
C
   20 IF (I .EQ. J) GO TO 60
      IF (R .LE. 0.5898437E0) THEN
         R = R+3.90625E-2
      ELSE
         R = R-0.21875E0
      ENDIF
C
   30 K = I
C
C     Select a central element of the array and save it in location T
C
      IJ = I + INT((J-I)*R)
      T = IX(IJ)
C
C     If first element of array is greater than T, interchange with T
C
      IF (IX(I) .GT. T) THEN
         IX(IJ) = IX(I)
         IX(I) = T
         T = IX(IJ)
      ENDIF
      L = J
C
C     If last element of array is less than than T, interchange with T
C
      IF (IX(J) .LT. T) THEN
         IX(IJ) = IX(J)
         IX(J) = T
         T = IX(IJ)
C
C        If first element of array is greater than T, interchange with T
C
         IF (IX(I) .GT. T) THEN
            IX(IJ) = IX(I)
            IX(I) = T
            T = IX(IJ)
         ENDIF
      ENDIF
C
C     Find an element in the second half of the array which is smaller
C     than T
C
   40 L = L-1
      IF (IX(L) .GT. T) GO TO 40
C
C     Find an element in the first half of the array which is greater
C     than T
C
   50 K = K+1
      IF (IX(K) .LT. T) GO TO 50
C
C     Interchange these elements
C
      IF (K .LE. L) THEN
         TT = IX(L)
         IX(L) = IX(K)
         IX(K) = TT
         GO TO 40
      ENDIF
C
C     Save upper and lower subscripts of the array yet to be sorted
C
      IF (L-I .GT. J-K) THEN
         IL(M) = I
         IU(M) = L
         I = K
         M = M+1
      ELSE
         IL(M) = K
         IU(M) = J
         J = L
         M = M+1
      ENDIF
      GO TO 70
C
C     Begin again on another portion of the unsorted array
C
   60 M = M-1
      IF (M .EQ. 0) GO TO 190
      I = IL(M)
      J = IU(M)
C
   70 IF (J-I .GE. 1) GO TO 30
      IF (I .EQ. 1) GO TO 20
      I = I-1
C
   80 I = I+1
      IF (I .EQ. J) GO TO 60
      T = IX(I+1)
      IF (IX(I) .LE. T) GO TO 80
      K = I
C
   90 IX(K+1) = IX(K)
      K = K-1
      IF (T .LT. IX(K)) GO TO 90
      IX(K+1) = T
      GO TO 80
C
C     Sort IX and carry IY along
C
  100 M = 1
      I = 1
      J = NN
      R = 0.375E0
C
  110 IF (I .EQ. J) GO TO 150
      IF (R .LE. 0.5898437E0) THEN
         R = R+3.90625E-2
      ELSE
         R = R-0.21875E0
      ENDIF
C
  120 K = I
C
C     Select a central element of the array and save it in location T
C
      IJ = I + INT((J-I)*R)
      T = IX(IJ)
      TY = IY(IJ)
C
C     If first element of array is greater than T, interchange with T
C
      IF (IX(I) .GT. T) THEN
         IX(IJ) = IX(I)
         IX(I) = T
         T = IX(IJ)
         IY(IJ) = IY(I)
         IY(I) = TY
         TY = IY(IJ)
      ENDIF
      L = J
C
C     If last element of array is less than T, interchange with T
C
      IF (IX(J) .LT. T) THEN
         IX(IJ) = IX(J)
         IX(J) = T
         T = IX(IJ)
         IY(IJ) = IY(J)
         IY(J) = TY
         TY = IY(IJ)
C
C        If first element of array is greater than T, interchange with T
C
         IF (IX(I) .GT. T) THEN
            IX(IJ) = IX(I)
            IX(I) = T
            T = IX(IJ)
            IY(IJ) = IY(I)
            IY(I) = TY
            TY = IY(IJ)
         ENDIF
      ENDIF
C
C     Find an element in the second half of the array which is smaller
C     than T
C
  130 L = L-1
      IF (IX(L) .GT. T) GO TO 130
C
C     Find an element in the first half of the array which is greater
C     than T
C
  140 K = K+1
      IF (IX(K) .LT. T) GO TO 140
C
C     Interchange these elements
C
      IF (K .LE. L) THEN
         TT = IX(L)
         IX(L) = IX(K)
         IX(K) = TT
         TTY = IY(L)
         IY(L) = IY(K)
         IY(K) = TTY
         GO TO 130
      ENDIF
C
C     Save upper and lower subscripts of the array yet to be sorted
C
      IF (L-I .GT. J-K) THEN
         IL(M) = I
         IU(M) = L
         I = K
         M = M+1
      ELSE
         IL(M) = K
         IU(M) = J
         J = L
         M = M+1
      ENDIF
      GO TO 160
C
C     Begin again on another portion of the unsorted array
C
  150 M = M-1
      IF (M .EQ. 0) GO TO 190
      I = IL(M)
      J = IU(M)
C
  160 IF (J-I .GE. 1) GO TO 120
      IF (I .EQ. 1) GO TO 110
      I = I-1
C
  170 I = I+1
      IF (I .EQ. J) GO TO 150
      T = IX(I+1)
      TY = IY(I+1)
      IF (IX(I) .LE. T) GO TO 170
      K = I
C
  180 IX(K+1) = IX(K)
      IY(K+1) = IY(K)
      K = K-1
      IF (T .LT. IX(K)) GO TO 180
      IX(K+1) = T
      IY(K+1) = TY
      GO TO 170
C
C     Clean up
C
  190 IF (KFLAG .LE. -1) THEN
         DO 200 I=1,NN
            IX(I) = -IX(I)
  200    CONTINUE
      ENDIF
      RETURN
      END

invivoisortii_isortii__199

Real time: 1.202479e+07 -- Predicted time: 9.773259e+06

Callcount: 1441

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
474	### 1	24.5491740299654	1.421200e+04	2.082400e+04	31.7
16	### 2	215.440677966102	8.370000e+02	4.720000e+02	43.6
160	### 3	149.790322580645	2.488000e+03	2.480000e+03	0.3
175	### 4	208.017130620985	3.358000e+03	3.736000e+03	10.1
70	### 5	273.447891805887	4.447000e+03	5.028000e+03	11.5
774	### 6	186.255140186916	5.339000e+03	8.560000e+03	37.6
968	### 7	305.896466212027	2.820000e+03	6.452000e+03	56.2
285	### 8	138.059778597786	8.688000e+03	1.084000e+04	19.8
722	### 9	1	3.900312e+06	4.022132e+06	3.0

                !
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nelemprint,
     &  neprint,stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
     &  ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,prestr,
     &  iprestr,noelplab,nodeflab,eei,een,iperturb,f,fn,
     &  nactdof,iout,qa,noprint,nodeprint,vold,b,nodeboun,ndirboun,
     &  xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,vmax,neq,
     &  veold,accold,bet,gam,dtime,plicon,nplicon,plkcon,nplkcon,
     &  xstateini,xstiff,xstate,npmat_,epn,matname,mint_,ielas,icmd,
     &  ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,sti,
     &  xstaten,eeiini,enerini,cocon,ncocon)
!
!     calculates and prints the displacements, temperatures and forces 
!     at the nodes and the stress and  strain  at the reduced integration 
!     points and at the nodes
!
!     iout=-1: v is assumed to be known and is used to
!              calculate strains, stresses..., no result output
!     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
!
      implicit none
!
      logical calcul_fn,calcul_f,calcul_cauchy,calcul_qa,cauchy
!
      character*4 noelplab(*),nodeflab(*)
      character*8 lakon(*)
      character*20 amat,matname(*),labmpc(*)
!
      integer kon(*),konl(20),inum(*),nelemprint(*),
     &  nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(*),ielorien(*),
     &  ntmat_,ipkon(*),nactdof(0:3,*),nodeprint(*),nodeboun(*),
     &  ndirboun(*),ipompc(*),nodempc(3,*),nelem,ikboun(*),ilboun(*),
     &  ncocon(2,*)
!
      integer nk,ne,neprint,mattyp,ithermal,iprestr,i,j,k,m1,m2,jj,
     &  i1,m3,m4,kk,iener,indexe,nope,norien,iperturb,iout,noprint,
     &  nal,icmd,ihyper,nboun,nmpc,nmethod,ist,ndir,node,index,
     &  neq,kode,imat,mint3d,mint_,nopev,nfield,ndim,iorien,ielas,
     &  istiff,icmdl,ncmat_,nstate_,incrementalmpc,lb,l,jmin,jmax
!
      integer nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
      real*8 co(3,*),v(0:3,*),shp(4,20),stiini(6,mint_,*),
     &  stx(6,mint_,*),stn(6,*),xl(3,20),vl(0:3,20),stre(9),
     &  elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),
     &  alcon(0:6,ntmat_,*),vini(0:3,*),
     &  alzero(*),orab(7,*),elas(21),alph(6),rho,f(*),fn(0:3,*),
     &  skl(3,3),anisox(3,3,3,3),beta(6),q(0:3,20),vkl(0:3,3),
     &  t0(*),t1(*),prestr(6,*),eei(6,mint_,*),een(6,*),ckl(3,3),
     &  vold(0:3,*),b(*),xboun(*),coefmpc(*),vmax,eloc(9),veold(0:3,*),
     &  accold(0:3,*),elconloc(21),eth(6),xkl(3,3),voldl(0:3,20),epn(*),
     &  xikl(3,3),ener(mint_,*),enern(*),sti(6,mint_,*),
     &  eeiini(6,mint_,*),enerini(mint_,*),cocon(0:6,ntmat_,*)
!
      real*8 e,un,al,um,am1,am2,xi,et,ze,tt,exx,eyy,ezz,exy,exz,eyz,
     &  xsj,qa,vj,t0l,t1l,bet,gam,dtime,forcempc,scal1,scal2,bnac,
     &  fixed_disp,weight,pgauss(3),vij,xkapp(6)
!
      real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
     &  xstiff(21,mint_,*),xstate(nstate_,mint_,*),plconloc(82),
     &  vokl(3,3),xstateini(nstate_,mint_,*),vikl(3,3),
     &  xstaten(nstate_,*)
!
      real*8 gauss2d1(2,1),gauss2d2(2,4),gauss2d3(2,9),gauss2d4(2,1),
     &  gauss2d5(2,3),gauss3d1(3,1),gauss3d2(3,8),gauss3d3(3,27),
     &  gauss3d4(3,1),gauss3d5(3,4),gauss3d6(3,15),gauss3d7(3,2),
     &  gauss3d8(3,9),gauss3d9(3,18),weight2d1(1),weight2d2(4),
     &  weight2d3(9),weight2d4(1),weight2d5(3),weight3d1(1),
     &  weight3d2(8),weight3d3(27),weight3d4(1),weight3d5(4),
     &  weight3d6(15),weight3d7(2),weight3d8(9),weight3d9(18)
!
      include "gauss.f"
!
      if(ithermal.le.1) then
         jmin=1
         jmax=3
      elseif(ithermal.eq.2) then
         jmin=0
         jmax=0
      else
         jmin=0
         jmax=3
      endif
!
      if((iout.ne.2).and.(iout.ne.-1)) then
!
         if((nmethod.ne.4).or.(iperturb.le.1)) then
!
!     extracting the displacement information from the solution
!
            do i=1,nk
               do j=jmin,jmax
                  if(nactdof(j,i).ne.0) then
                     v(j,i)=b(nactdof(j,i))
                  else
                     v(j,i)=0.d0
                  endif
               enddo
            enddo
!
!     for static perturbation steps v represents the incremental
!     displacements. For the total displacement vold must be added.
!
            if((iperturb.ne.0).and.(nmethod.eq.1)) then
               vmax=0.d0
               do i=1,nk
                  do j=jmin,jmax
                     vmax=max(vmax,dabs(v(j,i)))
c                     write(*,*) i,j,vold(j,i),v(j,i),vmax
                     v(j,i)=v(j,i)+vold(j,i)
                  enddo
               enddo
            endif
!
         else
!
!           direct integration dynamic step
!           b contains the acceleration increment
!
            if((ithermal.le.1).or.(ithermal.eq.3)) then
               scal1=bet*dtime*dtime
               scal2=gam*dtime
               vmax=0.d0
               do i=1,nk
                  do j=1,3
                     if(nactdof(j,i).ne.0) then
                        bnac=b(nactdof(j,i))
                        v(j,i)=vold(j,i)+scal1*bnac
                        vmax=max(vmax,dabs(scal1*bnac))
                        veold(j,i)=veold(j,i)+scal2*bnac
                        accold(j,i)=accold(j,i)+bnac
                     endif
                  enddo
               enddo
            endif
            if(ithermal.ge.2) then
               do i=1,nk
                  if(nactdof(0,i).ne.0) then
                     bnac=b(nactdof(0,i))
                     v(0,i)=vold(0,i)+bnac
                     vmax=max(vmax,dabs(bnac))
                     veold(0,i)=veold(0,i)+bnac/dtime
                  endif
               enddo
            endif
         endif
!
      endif
!
!        initialization
!
      calcul_fn=.false.
      calcul_f=.false.
      calcul_qa=.false.
      calcul_cauchy=.false.
!

!     determining which quantities have to be calculated
!
      if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.0))) then
         if(iout.lt.1) then
            calcul_fn=.true.
            calcul_f=.true.
            calcul_qa=.true.
         else    
            calcul_cauchy=.true.
         endif
      endif
      if(((noelplab(5).eq.'RF').or.(nodeflab(5).eq.'RF'))
     &     .and.(iout.gt.0)) calcul_fn=.true.
!
!     initializing fn
!
      if(calcul_fn) then
         do i=1,nk
            do j=1,3
               fn(j,i)=0.d0
            enddo
         enddo
      endif
!
!     initializing f
!
      if(calcul_f) then
         do i=1,neq
            f(i)=0.d0
         enddo
      endif
!
!     inserting the boundary conditions
!
      do i=1,nboun
         if(ndirboun(i).gt.3) cycle
         fixed_disp=xboun(i)
         if((nmethod.eq.4).and.(iperturb.gt.1)) then
            ndir=ndirboun(i)
            node=nodeboun(i)
            accold(ndir,node)=(xboun(i)-v(ndir,node))/
     &        (bet*dtime*dtime)
            veold(ndir,node)=veold(ndir,node)+
     &        gam*dtime*accold(ndir,node)
         endif
         v(ndirboun(i),nodeboun(i))=fixed_disp
c         write(*,*) 'boun ',nodeboun(i),ndirboun(i),fixed_disp
      enddo
!
!     inserting the mpc information
!     the parameter incrementalmpc indicates whether the
!     incremental displacements enter the mpc or the total 
!     displacements (incrementalmpc=0)
!
      do i=1,nmpc
         if((labmpc(i)(1:20).eq.'                    ').or.
     &      (labmpc(i)(1:6).eq.'CYCLIC').or.
     &      (labmpc(i)(1:5).eq.'RIGID').or.
     &      (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
            incrementalmpc=0
         else
            incrementalmpc=1
         endif
         ist=ipompc(i)
         node=nodempc(1,ist)
         ndir=nodempc(2,ist)
         index=nodempc(3,ist)
         fixed_disp=0.d0
         if(index.ne.0) then
            do
               if(incrementalmpc.eq.0) then
                  fixed_disp=fixed_disp-coefmpc(index)*
     &                 v(nodempc(2,index),nodempc(1,index))
               else
c                  write(*,102) 
c     &             nodempc(1,index),nodempc(2,index),
c     &             v(nodempc(2,index),nodempc(1,index)),
c     &             vold(nodempc(2,index),nodempc(1,index))
c 102              format('results,node,dir,newvalue,oldvalue',2i5,
c     &                2(1x,e11.4))
                  fixed_disp=fixed_disp-coefmpc(index)*
     &                 (v(nodempc(2,index),nodempc(1,index))-
     &                  vold(nodempc(2,index),nodempc(1,index)))
c                  write(*,*) fixed_disp,
c     & vold(nodempc(2,index),nodempc(1,index)),
c     & v(nodempc(2,index),nodempc(1,index))
               endif
               index=nodempc(3,index)
               if(index.eq.0) exit
            enddo
         endif
         fixed_disp=fixed_disp/coefmpc(ist)
c                  write(*,*) fixed_disp
         if(incrementalmpc.eq.1) then
            fixed_disp=fixed_disp+vold(ndir,node)
c            write(*,*) 'results ',i,vold(ndir,node),fixed_disp
         endif
         if((nmethod.eq.4).and.(iperturb.gt.1)) then
            accold(ndir,node)=(fixed_disp-v(ndir,node))/
     &        (bet*dtime*dtime)
            veold(ndir,node)=veold(ndir,node)+
     &        gam*dtime*accold(ndir,node)
         endif
         v(ndir,node)=fixed_disp
c         write(*,102) node,ndir,v(ndir,node),vold(ndir,node)
      enddo
!
!     check whether there are any strain output requests
!
      if ((noelplab(7).eq.'ENER').or.(nodeflab(7).eq.'ENER')) then
         iener=1
      else
         iener=0
      endif
!
      qa=0.d0
      nal=0
!
!     calculation of the stresses in the integration points
! 
      if((ithermal.le.1).or.(ithermal.eq.3)) then
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         imat=ielmat(i)
         amat=matname(imat)
         if(norien.gt.0) then
            iorien=ielorien(i)
         else
            iorien=0
         endif
!
c         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         if(lakon(i)(4:4).eq.'2') then
            nope=20
         elseif(lakon(i)(4:4).eq.'8') then
            nope=8
         elseif(lakon(i)(4:5).eq.'10') then
            nope=10
         elseif(lakon(i)(4:4).eq.'4') then
            nope=4
         elseif(lakon(i)(4:5).eq.'15') then
            nope=15
         else
            nope=6
         endif
!
         if(lakon(i)(4:5).eq.'8R') then
            mint3d=1
         elseif((lakon(i)(4:4).eq.'8').or.
     &          (lakon(i)(4:6).eq.'20R')) then
            mint3d=8
         elseif(lakon(i)(4:4).eq.'2') then
            mint3d=27
         elseif(lakon(i)(4:5).eq.'10') then
            mint3d=4
         elseif(lakon(i)(4:4).eq.'4') then
            mint3d=1
         elseif(lakon(i)(4:5).eq.'15') then
            mint3d=9
         else
            mint3d=2
         endif
!
         do j=1,nope
            konl(j)=kon(indexe+j)
            do k=1,3
               xl(k,j)=co(k,konl(j))
               vl(k,j)=v(k,konl(j))
               voldl(k,j)=vold(k,konl(j))
            enddo
         enddo
!
!        check for hyperelastic material
!
         if(nelcon(1,imat).lt.0) then
            ihyper=1
         else
            ihyper=0
         endif
!
!        q contains the nodal forces per element; initialisation of q
!
         if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.1))) then
            do m1=1,nope
               do m2=1,3
                  q(m2,m1)=fn(m2,konl(m1))
               enddo
            enddo
         endif
!
         do jj=1,mint3d
            if(lakon(i)(4:5).eq.'8R') then
               xi=gauss3d1(1,jj)
               et=gauss3d1(2,jj)
               ze=gauss3d1(3,jj)
               weight=weight3d1(jj)
            elseif((lakon(i)(4:4).eq.'8').or.
     &             (lakon(i)(4:6).eq.'20R'))
     &        then
               xi=gauss3d2(1,jj)
c               if(nope.eq.20) xi=xi+1.d0
               et=gauss3d2(2,jj)
               ze=gauss3d2(3,jj)
               weight=weight3d2(jj)
            elseif(lakon(i)(4:4).eq.'2') then
c               xi=gauss3d3(1,jj)+1.d0
               xi=gauss3d3(1,jj)
               et=gauss3d3(2,jj)
               ze=gauss3d3(3,jj)
               weight=weight3d3(jj)
            elseif(lakon(i)(4:5).eq.'10') then
               xi=gauss3d5(1,jj)
               et=gauss3d5(2,jj)
               ze=gauss3d5(3,jj)
               weight=weight3d5(jj)
            elseif(lakon(i)(4:4).eq.'4') then
               xi=gauss3d4(1,jj)
               et=gauss3d4(2,jj)
               ze=gauss3d4(3,jj)
               weight=weight3d4(jj)
            elseif(lakon(i)(4:5).eq.'15') then
               xi=gauss3d8(1,jj)
               et=gauss3d8(2,jj)
               ze=gauss3d8(3,jj)
               weight=weight3d8(jj)
            else
               xi=gauss3d7(1,jj)
               et=gauss3d7(2,jj)
               ze=gauss3d7(3,jj)
               weight=weight3d7(jj)
            endif
!
            if(nope.eq.20) then
               call shape20h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.8) then
               call shape8h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.10) then
               call shape10tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.4) then
               call shape4tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.15) then
               call shape15w(xi,et,ze,xl,xsj,shp)
            else
               call shape6w(xi,et,ze,xl,xsj,shp)
            endif
!
!                 vkl(m2,m3) contains the derivative of the m2-
!                 component of the displacement with respect to
!                 direction m3
!
            do m2=1,3
               do m3=1,3
                  vkl(m2,m3)=0.d0
               enddo
            enddo
!
            do m1=1,nope
               do m2=1,3
                  do m3=1,3
                     vkl(m2,m3)=vkl(m2,m3)+shp(m3,m1)*vl(m2,m1)
                  enddo
               enddo
            enddo
!
            kode=nelcon(1,imat)
!
!                 calculating the strain
!
!                 attention! exy,exz and eyz are engineering strains!
!
            exx=vkl(1,1)
            eyy=vkl(2,2)
            ezz=vkl(3,3)
            exy=vkl(1,2)+vkl(2,1)
            exz=vkl(1,3)+vkl(3,1)
            eyz=vkl(2,3)+vkl(3,2)
!
!                 Lagrangian/Eulerian strain tensor for geometric
!                 nonlinear calculations
!
            if(iperturb.ge.2) then
!
!                    Lagrangian strain
!
               exx=exx+(vkl(1,1)**2+vkl(2,1)**2+vkl(3,1)**2)/2.d0
               eyy=eyy+(vkl(1,2)**2+vkl(2,2)**2+vkl(3,2)**2)/2.d0
               ezz=ezz+(vkl(1,3)**2+vkl(2,3)**2+vkl(3,3)**2)/2.d0
               exy=exy+vkl(1,1)*vkl(1,2)+vkl(2,1)*vkl(2,2)+
     &              vkl(3,1)*vkl(3,2)
               exz=exz+vkl(1,1)*vkl(1,3)+vkl(2,1)*vkl(2,3)+
     &              vkl(3,1)*vkl(3,3)
               eyz=eyz+vkl(1,2)*vkl(1,3)+vkl(2,2)*vkl(2,3)+
     &              vkl(3,2)*vkl(3,3)
!
            endif
!
!                 storing the local strains
!
            if((iperturb.ne.0).or.(iout.ge.0)) then
               eloc(1)=exx
               eloc(2)=eyy
               eloc(3)=ezz
               eloc(4)=exy/2.d0
               eloc(5)=exz/2.d0
               eloc(6)=eyz/2.d0
            else
!
!                    linear iteration within a nonlinear increment:
!                    tangent matrix is calculated at strain at
!                    the end of the previous increment
!
               do m1=1,6
                  eloc(m1)=eei(m1,jj,i)
               enddo
            endif
!
!                 calculating the deformation gradient (needed to
!                 convert the element stiffness matrix from spatial
!                 coordinates to material coordinates
!                 deformation plasticity)
!
            if((kode.eq.-50).or.(kode.le.-100)) then
!
!                    calculating the deformation gradient
!
               xkl(1,1)=vkl(1,1)+1
               xkl(2,2)=vkl(2,2)+1.
               xkl(3,3)=vkl(3,3)+1.
               xkl(1,2)=vkl(1,2)
               xkl(1,3)=vkl(1,3)
               xkl(2,3)=vkl(2,3)
               xkl(2,1)=vkl(2,1)
               xkl(3,1)=vkl(3,1)
               xkl(3,2)=vkl(3,2)
!
!                    calculating the Jacobian
!
               vj=xkl(1,1)*(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))
     &              -xkl(1,2)*(xkl(2,1)*xkl(3,3)-xkl(2,3)*xkl(3,1))
     &              +xkl(1,3)*(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))
!
!              inversion of the deformation gradient (only for
!              deformation plasticity)
!
               if(kode.eq.-50) then
!
                  ckl(1,1)=(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))/vj
                  ckl(2,2)=(xkl(1,1)*xkl(3,3)-xkl(1,3)*xkl(3,1))/vj
                  ckl(3,3)=(xkl(1,1)*xkl(2,2)-xkl(1,2)*xkl(2,1))/vj
                  ckl(1,2)=(xkl(1,3)*xkl(3,2)-xkl(1,2)*xkl(3,3))/vj
                  ckl(1,3)=(xkl(1,2)*xkl(2,3)-xkl(2,2)*xkl(1,3))/vj
                  ckl(2,3)=(xkl(2,1)*xkl(1,3)-xkl(1,1)*xkl(2,3))/vj
                  ckl(2,1)=(xkl(3,1)*xkl(2,3)-xkl(2,1)*xkl(3,3))/vj
                  ckl(3,1)=(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))/vj
                  ckl(3,2)=(xkl(3,1)*xkl(1,2)-xkl(1,1)*xkl(3,2))/vj
!
!                 converting the Lagrangian strain into Eulerian
!                 strain (only for deformation plasticity)
!
                  cauchy=.false.
                  call str2mat(eloc,ckl,vj,cauchy)
               endif
!                        
            endif
!
!                 calculating fields for incremental plasticity
!
            if(kode.le.-100) then
!
!              calculating the deformation gradient at the
!              start of the increment
!
!              calculating the displacement gradient at the
!              start of the increment
!
               do m2=1,3
                  do m3=1,3
                     vikl(m2,m3)=0.d0
                  enddo
               enddo
!
               do m1=1,nope
                  do m2=1,3
                     do m3=1,3
                        vikl(m2,m3)=vikl(m2,m3)
     &                       +shp(m3,m1)*vini(m2,konl(m1))
                     enddo
                  enddo
               enddo
!
!              calculating the deformation gradient of the old
!              fields
!
               xikl(1,1)=vikl(1,1)+1
               xikl(2,2)=vikl(2,2)+1.
               xikl(3,3)=vikl(3,3)+1.
               xikl(1,2)=vikl(1,2)
               xikl(1,3)=vikl(1,3)
               xikl(2,3)=vikl(2,3)
               xikl(2,1)=vikl(2,1)
               xikl(3,1)=vikl(3,1)
               xikl(3,2)=vikl(3,2)
!
!              calculating the Jacobian
!
               vij=xikl(1,1)*(xikl(2,2)*xikl(3,3)
     &              -xikl(2,3)*xikl(3,2))
     &              -xikl(1,2)*(xikl(2,1)*xikl(3,3)
     &              -xikl(2,3)*xikl(3,1))
     &              +xikl(1,3)*(xikl(2,1)*xikl(3,2)
     &              -xikl(2,2)*xikl(3,1))
!
!              stresses at the start of the increment
!
               do m1=1,6
                  stre(m1)=stiini(m1,jj,i)
               enddo
!
            endif
!
!                 prestress values
!
            if(iprestr.eq.0) then
               do kk=1,6
                  beta(kk)=0.d0
               enddo
            else
               do kk=1,6
                  beta(kk)=-prestr(kk,i)
               enddo
            endif
!
            if(ithermal.ge.1) then
!
!              calculating the temperature difference in
!              the integration point
!
               t0l=0.d0
               t1l=0.d0
               if(ithermal.eq.1) then
                  if(lakon(i)(4:5).eq.'8 ') then
                     do i1=1,nope
                        t0l=t0l+t0(konl(i1))/8.d0
                        t1l=t1l+t1(konl(i1))/8.d0
                     enddo
                  elseif(lakon(i)(4:6).eq.'20 ') then
                     call lintemp(t0,t1,konl,nope,jj,t0l,t1l)
                  else
                     do i1=1,nope
                        t0l=t0l+shp(4,i1)*t0(konl(i1))
                        t1l=t1l+shp(4,i1)*t1(konl(i1))
                     enddo
                  endif
               elseif(ithermal.ge.2) then
                  if(lakon(i)(4:5).eq.'8 ') then
                     do i1=1,nope
                        t0l=t0l+t0(konl(i1))/8.d0
                        t1l=t1l+vold(0,konl(i1))/8.d0
                     enddo
                  elseif(lakon(i)(4:6).eq.'20 ') then
                     call lintemp_th(t0,vold,konl,nope,jj,t0l,t1l)
                  else
                     do i1=1,nope
                        t0l=t0l+shp(4,i1)*t0(konl(i1))
                        t1l=t1l+shp(4,i1)*vold(0,konl(i1))
                     enddo
                  endif
               endif
               tt=t1l-t0l
            endif
!
!                 calculating the coordinates of the integration point
!                 for material orientation purposes (for cylindrical
!                 coordinate systems)
!
            if(iorien.gt.0) then
               do j=1,3
                  pgauss(j)=0.d0
                  do i1=1,nope
                     pgauss(j)=pgauss(j)+shp(4,i1)*co(j,konl(i1))
                  enddo
               enddo
            endif
!
!                 material data; for linear elastic materials
!                 this includes the calculation of the stiffness
!                 matrix
!
            istiff=0
!
            call materialdata(elcon,nelcon,rhcon,nrhcon,alcon,
     &           nalcon,imat,amat,iorien,pgauss,orab,ntmat_,
     &           elas,alph,rho,i,ithermal,alzero,mattyp,
     &           t0l,t1l,ihyper,istiff,
     &           elconloc,eth,kode,plicon,nplicon,
     &           plkcon,nplkcon,npmat_,
     &           plconloc,mint_,dtime,i,jj,
     &           xstiff,ncmat_)
!
            if((ihyper.eq.0).and.
     &           ((iperturb.ne.0).or.(iout.ge.0))) then
               if(mattyp.eq.1) then
                  e=elas(1)
                  un=elas(2)
                  al=un*e/(1.d0+un)/(1.d0-2.d0*un)
                  um=e/2.d0/(1.d0+un)
                  am1=al+2.d0*um
                  am2=2.d0*um
               elseif(mattyp.eq.3) then
                  call anisotropic(elas,anisox)
               endif
!
               icmdl=3
               call linel(ithermal,mattyp,beta,al,um,am1,alph,tt,
     &              elas,icmdl,exx,eyy,ezz,exy,exz,eyz,stre,
     &              anisox)
!
            elseif(ihyper.ne.0) then
               mattyp=3
               call hyperel(elconloc,elas,eloc,kode,eth,ithermal,
     &              icmd,beta,stre,xkl,ckl,vj,xikl,vij,
     &              plconloc,xstate,xstateini,ielas,
     &              amat,t1l,dtime,i,jj,nstate_,mint_,
     &              iorien,pgauss,orab)
               do m1=1,21
                  xstiff(m1,jj,i)=elas(m1)
               enddo
            endif
!
            if((iperturb.eq.0).and.(iout.lt.0)) then
!
!                    if the forced displacements were changed at
!                    the start of a nonlinear step, the nodal
!                    forces due do this displacements are 
!                    calculated in a purely linear way, and
!                    the first iteration is purely linear in order
!                    to allow the displacements to redistribute
!                    in a quasi-static way (only applies to
!                    quasi-static analyses (*STATIC))
!
               do m2=1,3
                  do m3=1,3
                     vokl(m2,m3)=0.d0
                  enddo
               enddo
!
               do m1=1,nope
                  do m2=1,3
                     do m3=1,3
                        vokl(m2,m3)=vokl(m2,m3)+
     &                       shp(m3,m1)*voldl(m2,m1)
                     enddo
                  enddo
               enddo
!
               eloc(1)=exx-vokl(1,1)
               eloc(2)=eyy-vokl(2,2)
               eloc(3)=ezz-vokl(3,3)
               eloc(4)=exy-(vokl(1,2)+vokl(2,1))
               eloc(5)=exz-(vokl(1,3)+vokl(3,1))
               eloc(6)=eyz-(vokl(2,3)+vokl(3,2))
               if(mattyp.eq.1) then
                  e=elas(1)
                  un=elas(2)
                  um=e/(1.d0+un)
                  al=un*um/(1.d0-2.d0*un)
                  um=um/2.d0
                  am1=al*(eloc(1)+eloc(2)+eloc(3))
                  stre(1)=am1+2.d0*um*eloc(1)
                  stre(2)=am1+2.d0*um*eloc(2)
                  stre(3)=am1+2.d0*um*eloc(3)
                  stre(4)=um*eloc(4)
                  stre(5)=um*eloc(5)
                  stre(6)=um*eloc(6)
               elseif(mattyp.eq.2) then
                  stre(1)=eloc(1)*elas(1)+eloc(2)*elas(2)
     &                 +eloc(3)*elas(4)
                  stre(2)=eloc(1)*elas(2)+eloc(2)*elas(3)
     &                 +eloc(3)*elas(5)
                  stre(3)=eloc(1)*elas(4)+eloc(2)*elas(5)
     &                 +eloc(3)*elas(6)
                  stre(4)=eloc(4)*elas(7)
                  stre(5)=eloc(5)*elas(8)
                  stre(6)=eloc(6)*elas(9)
               elseif(mattyp.eq.3) then
                  stre(1)=eloc(1)*elas(1)+eloc(2)*elas(2)+
     &                 eloc(3)*elas(4)+eloc(4)*elas(7)+
     &                 eloc(5)*elas(11)+eloc(6)*elas(16)
                  stre(2)=eloc(1)*elas(2)+eloc(2)*elas(3)+
     &                 eloc(3)*elas(5)+eloc(4)*elas(8)+
     &                 eloc(5)*elas(12)+eloc(6)*elas(17)
                  stre(3)=eloc(1)*elas(4)+eloc(2)*elas(5)+
     &                 eloc(3)*elas(6)+eloc(4)*elas(9)+
     &                 eloc(5)*elas(13)+eloc(6)*elas(18)
                  stre(4)=eloc(1)*elas(7)+eloc(2)*elas(8)+
     &                 eloc(3)*elas(9)+eloc(4)*elas(10)+
     &                 eloc(5)*elas(14)+eloc(6)*elas(19)
                  stre(5)=eloc(1)*elas(11)+eloc(2)*elas(12)+
     &                 eloc(3)*elas(13)+eloc(4)*elas(14)+
     &                 eloc(5)*elas(15)+eloc(6)*elas(20)
                  stre(6)=eloc(1)*elas(16)+eloc(2)*elas(17)+
     &                 eloc(3)*elas(18)+eloc(4)*elas(19)+
     &                 eloc(5)*elas(20)+eloc(6)*elas(21)
               endif
            endif
! 
!           updating the energy
!
            if(iener.eq.1) then
               ener(jj,i)=enerini(jj,i)+
     &           ((eloc(1)-eeiini(1,jj,i))*(stre(1)+stiini(1,jj,i))+
     &            (eloc(2)-eeiini(2,jj,i))*(stre(2)+stiini(2,jj,i))+
     &            (eloc(3)-eeiini(3,jj,i))*(stre(3)+stiini(3,jj,i)))
     &            /2.d0+
     &            (eloc(4)-eeiini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
     &            (eloc(5)-eeiini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
     &            (eloc(6)-eeiini(6,jj,i))*(stre(6)+stiini(6,jj,i))
c               write(*,*) 'energy',jj,i,ener(jj,i)
            endif
!
            eei(1,jj,i)=eloc(1)
            eei(2,jj,i)=eloc(2)
            eei(3,jj,i)=eloc(3)
            eei(4,jj,i)=eloc(4)
            eei(5,jj,i)=eloc(5)
            eei(6,jj,i)=eloc(6)
!
            skl(1,1)=stre(1)
            skl(2,2)=stre(2)
            skl(3,3)=stre(3)
            skl(2,1)=stre(4)
            skl(3,1)=stre(5)
            skl(3,2)=stre(6)
!
            stx(1,jj,i)=skl(1,1)
            stx(2,jj,i)=skl(2,2)
            stx(3,jj,i)=skl(3,3)
            stx(4,jj,i)=skl(2,1)
            stx(5,jj,i)=skl(3,1)
            stx(6,jj,i)=skl(3,2)
!
            skl(1,2)=skl(2,1)
            skl(1,3)=skl(3,1)
            skl(2,3)=skl(3,2)
!
!                 calculation of the nodal forces
!
            if(calcul_fn)then
!
!                    calculating fn using skl
!
               do m1=1,nope
                  do m2=1,3
!
!                          linear elastic part
!                           
                     do m3=1,3
                        fn(m2,konl(m1))=fn(m2,konl(m1))+
     &                       xsj*skl(m2,m3)*shp(m3,m1)*weight
                     enddo
!
!                          nonlinear geometric part
!
                     if(iperturb.ge.2) then
                        do m3=1,3
                           do m4=1,3
                              fn(m2,konl(m1))=fn(m2,konl(m1))+
     &                             xsj*skl(m4,m3)*weight*
     &                             (vkl(m2,m4)*shp(m3,m1)+
     &                             vkl(m2,m3)*shp(m4,m1))/2.d0
                           enddo
                        enddo
                     endif
!
                  enddo
               enddo
            endif
!
!           calculation of the Cauchy stresses
!
            if(calcul_cauchy) then
!
!              changing the displacement gradients into
!              deformation gradients
!
               if(kode.ne.-50) then
                  xkl(1,1)=vkl(1,1)+1
                  xkl(2,2)=vkl(2,2)+1.
                  xkl(3,3)=vkl(3,3)+1.
                  xkl(1,2)=vkl(1,2)
                  xkl(1,3)=vkl(1,3)
                  xkl(2,3)=vkl(2,3)
                  xkl(2,1)=vkl(2,1)
                  xkl(3,1)=vkl(3,1)
                  xkl(3,2)=vkl(3,2)
!
                  vj=xkl(1,1)*(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))
     &                 -xkl(1,2)*(xkl(2,1)*xkl(3,3)-xkl(2,3)*xkl(3,1))
     &                 +xkl(1,3)*(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))
               endif
!
               do m1=1,3
                  do m2=1,m1
                     ckl(m1,m2)=0.d0
                     do m3=1,3
                        do m4=1,3
                           ckl(m1,m2)=ckl(m1,m2)+
     &                          skl(m3,m4)*xkl(m1,m3)*xkl(m2,m4)
                        enddo
                     enddo
                     ckl(m1,m2)=ckl(m1,m2)/vj
                  enddo
               enddo
!
               stx(1,jj,i)=ckl(1,1)
               stx(2,jj,i)=ckl(2,2)
               stx(3,jj,i)=ckl(3,3)
               stx(4,jj,i)=ckl(2,1)
               stx(5,jj,i)=ckl(3,1)
               stx(6,jj,i)=ckl(3,2)
            endif
!
         enddo
!
!        q contains the contributions to the nodal force in the nodes
!        belonging to the element at stake from other elements (elements
!        already treated). These contributions have to be
!        subtracted to get the contributions attributable to the element
!        at stake only
!
         if(calcul_qa) then
            do m1=1,nope
               do m2=1,3
                  qa=qa+dabs(fn(m2,konl(m1))-q(m2,m1))
               enddo
            enddo
            nal=nal+3*nope
         endif
      enddo
!
      endif
!
!     calculation of temperatures and thermal flux
!
      if(ithermal.ge.2) then
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         imat=ielmat(i)
         amat=matname(imat)
         if(norien.gt.0) then
            iorien=ielorien(i)
         else
            iorien=0
         endif
!
         indexe=ipkon(i)
         if(lakon(i)(4:4).eq.'2') then
            nope=20
         elseif(lakon(i)(4:4).eq.'8') then
            nope=8
         elseif(lakon(i)(4:5).eq.'10') then
            nope=10
         elseif(lakon(i)(4:4).eq.'4') then
            nope=4
         elseif(lakon(i)(4:5).eq.'15') then
            nope=15
         else
            nope=6
         endif
!
         if(lakon(i)(4:5).eq.'8R') then
            mint3d=1
         elseif((lakon(i)(4:4).eq.'8').or.
     &          (lakon(i)(4:6).eq.'20R')) then
            mint3d=8
         elseif(lakon(i)(4:4).eq.'2') then
            mint3d=27
         elseif(lakon(i)(4:5).eq.'10') then
            mint3d=4
         elseif(lakon(i)(4:4).eq.'4') then
            mint3d=1
         elseif(lakon(i)(4:5).eq.'15') then
            mint3d=9
         else
            mint3d=2
         endif
!
         do j=1,nope
            konl(j)=kon(indexe+j)
            do k=1,3
               xl(k,j)=co(k,konl(j))
            enddo
            vl(0,j)=v(0,konl(j))
            voldl(0,j)=vold(0,konl(j))
         enddo
!
!        q contains the nodal forces per element; initialisation of q
!
         if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.1))) then
            do m1=1,nope
               q(0,m1)=fn(0,konl(m1))
            enddo
         endif
!
         do jj=1,mint3d
            if(lakon(i)(4:5).eq.'8R') then
               xi=gauss3d1(1,jj)
               et=gauss3d1(2,jj)
               ze=gauss3d1(3,jj)
               weight=weight3d1(jj)
            elseif((lakon(i)(4:4).eq.'8').or.
     &             (lakon(i)(4:6).eq.'20R'))
     &        then
               xi=gauss3d2(1,jj)
               et=gauss3d2(2,jj)
               ze=gauss3d2(3,jj)
               weight=weight3d2(jj)
            elseif(lakon(i)(4:4).eq.'2') then
               xi=gauss3d3(1,jj)
               et=gauss3d3(2,jj)
               ze=gauss3d3(3,jj)
               weight=weight3d3(jj)
            elseif(lakon(i)(4:5).eq.'10') then
               xi=gauss3d5(1,jj)
               et=gauss3d5(2,jj)
               ze=gauss3d5(3,jj)
               weight=weight3d5(jj)
            elseif(lakon(i)(4:4).eq.'4') then
               xi=gauss3d4(1,jj)
               et=gauss3d4(2,jj)
               ze=gauss3d4(3,jj)
               weight=weight3d4(jj)
            elseif(lakon(i)(4:5).eq.'15') then
               xi=gauss3d8(1,jj)
               et=gauss3d8(2,jj)
               ze=gauss3d8(3,jj)
               weight=weight3d8(jj)
            else
               xi=gauss3d7(1,jj)
               et=gauss3d7(2,jj)
               ze=gauss3d7(3,jj)
               weight=weight3d7(jj)
            endif
!
            if(nope.eq.20) then
               call shape20h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.8) then
               call shape8h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.10) then
               call shape10tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.4) then
               call shape4tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.15) then
               call shape15w(xi,et,ze,xl,xsj,shp)
            else
               call shape6w(xi,et,ze,xl,xsj,shp)
            endif
!
!                 vkl(m2,m3) contains the derivative of the m2-
!                 component of the displacement with respect to
!                 direction m3
!
            do m3=1,3
               vkl(0,m3)=0.d0
            enddo
!
            do m1=1,nope
               do m3=1,3
                  vkl(0,m3)=vkl(0,m3)+shp(m3,m1)*vl(0,m1)
               enddo
            enddo
!
            kode=nelcon(1,imat)
!
!           storing the temperature gradients
!
            eloc(7)=vkl(0,1)
            eloc(8)=vkl(0,2)
            eloc(9)=vkl(0,3)
!
!              calculating the temperature difference in
!              the integration point
!
            t1l=0.d0
            if(lakon(i)(4:5).eq.'8 ') then
               do i1=1,nope
                  t1l=t1l+vold(0,konl(i1))/8.d0
               enddo
            elseif(lakon(i)(4:6).eq.'20 ') then
               call lintemp_th(t0,vold,konl,nope,jj,t0l,t1l)
            else
               do i1=1,nope
                  t1l=t1l+shp(4,i1)*vold(0,konl(i1))
               enddo
            endif
!
!           calculating the coordinates of the integration point
!           for material orientation purposes (for cylindrical
!           coordinate systems)
!
            if(iorien.gt.0) then
               do j=1,3
                  pgauss(j)=0.d0
                  do i1=1,nope
                     pgauss(j)=pgauss(j)+shp(4,i1)*co(j,konl(i1))
                  enddo
               enddo
            endif
!
!                 material data; for linear elastic materials
!                 this includes the calculation of the stiffness
!                 matrix
!
            call matdata_co(cocon,ncocon,imat,iorien,pgauss,orab,ntmat_,
     &           xkapp,mattyp,t1l)
!
            if(mattyp.eq.1) then
               do m1=1,3
                  stre(6+m1)=xkapp(1)*vkl(0,m1)
               enddo
            elseif(mattyp.eq.2) then
               stre(7)=xkapp(1)*vkl(0,1)
               stre(8)=xkapp(2)*vkl(0,2)
               stre(9)=xkapp(3)*vkl(0,3)
            else
               stre(7)=xkapp(1)*vkl(0,1)+xkapp(2)*vkl(0,2)+
     &                 xkapp(4)*vkl(0,3)
               stre(8)=xkapp(2)*vkl(0,1)+xkapp(3)*vkl(0,2)+
     &                 xkapp(5)*vkl(0,3)
               stre(9)=xkapp(4)*vkl(0,1)+xkapp(5)*vkl(0,2)+
     &                 xkapp(6)*vkl(0,3)
            endif
! 
!           updating the energy
!
c            if(iener.eq.1) then
c               ener(jj,i)=enerini(jj,i)+
c     &           ((eloc(1)-eeiini(1,jj,i))*(stre(1)+stiini(1,jj,i))+
c     &            (eloc(2)-eeiini(2,jj,i))*(stre(2)+stiini(2,jj,i))+
c     &            (eloc(3)-eeiini(3,jj,i))*(stre(3)+stiini(3,jj,i)))
c     &            /2.d0+
c     &            (eloc(4)-eeiini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
c     &            (eloc(5)-eeiini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
c     &            (eloc(6)-eeiini(6,jj,i))*(stre(6)+stiini(6,jj,i))
c               write(*,*) 'energy',jj,i,ener(jj,i)
c            endif
!
!           dimension of stx should be 9!!!!!!
!
c            stx(7,jj,i)=skl(1,1)
c            stx(8,jj,i)=skl(2,2)
c            stx(9,jj,i)=skl(3,3)
!
!           calculation of the nodal flux
!
            if(calcul_fn)then
!
!                    calculating fn using skl
!
               do m1=1,nope
                  do m3=1,3
                     fn(0,konl(m1))=fn(0,konl(m1))+
     &                    xsj*stre(m3)*shp(m3,m1)*weight
                  enddo
               enddo
            endif
         enddo
!
!        q contains the contributions to the nodal force in the nodes
!        belonging to the element at stake from other elements (elements
!        already treated). These contributions have to be
!        subtracted to get the contributions attributable to the element
!        at stake only
!
         if(calcul_qa) then
            do m1=1,nope
               do m2=1,3
                  qa=qa+dabs(fn(m2,konl(m1))-q(m2,m1))
               enddo
            enddo
            nal=nal+3*nope
         endif
      enddo
!
      endif
!
      if(calcul_qa) qa=qa/nal
!
!     subtracting the mpc force (for each linear mpc there is one
!     force; the actual force in a node belonging to the mpc is
!     obtained by multiplying this force with the nodal coefficient.
!     The force has to be subtracted from f, since it does not
!     appear on the rhs of the equations system
!
        do i=1,nmpc
            ist=ipompc(i)
            node=nodempc(1,ist)
            ndir=nodempc(2,ist)
            forcempc=fn(ndir,node)/coefmpc(ist)
            fn(ndir,node)=0.d0
            index=nodempc(3,ist)
            if(index.eq.0) cycle
            do
               node=nodempc(1,index)
               ndir=nodempc(2,index)
               fn(ndir,node)=fn(ndir,node)-coefmpc(index)*forcempc
               index=nodempc(3,index)
               if(index.eq.0) exit
            enddo
         enddo
!
!     calculating the system force vector
!
      if(calcul_f) then
         do i=1,nk
            do j=1,3
c               write(*,500) i,j,fn(j,i)
c 500           format(i5,',',i5,',',e11.4)
               if(nactdof(j,i).ne.0) then
                  f(nactdof(j,i))=fn(j,i)
               endif
            enddo
         enddo
!
!     subtracting the mpc force (for each linear mpc there is one
!     force; the actual force in a node belonging to the mpc is
!     obtained by multiplying this force with the nodal coefficient.
!     The force has to be subtracted from f, since it does not
!     appear on the rhs of the equations system
!
c         do i=1,nmpc
c            ist=ipompc(i)
c            node=nodempc(1,ist)
c            ndir=nodempc(2,ist)
c            forcempc=fn(ndir,node)/coefmpc(ist)
c            index=nodempc(3,ist)
c            if(index.eq.0) cycle
c            do
c               node=nodempc(1,index)
c               ndir=nodempc(2,index)
c               j=nactdof(ndir,node)
c
c to be modified for nodes which do not belong to any elements:
c  thus there is no stress and no force is calculated
c  example: rigid body motion
c
c               if(j.ne.0) then
c                  f(j)=f(j)-coefmpc(index)*forcempc
c               endif
c               index=nodempc(3,index)
c               if(index.eq.0) exit
c            enddo
c         enddo
      endif
!
!     no print requests
!
      if(iout.le.0) return
!
!     nodal printing requests
!
      write(*,*) 'Printing nodal quantities'
      write(*,*)
!
      if(noprint.ne.0) then
         if(noelplab(1).eq.'U   ') then
            write(5,*)
            write(5,*) 'displacements (vx,vy,vz)'
            write(5,*)
            do i=1,noprint
               write(5,'(i5,1p,3(1x,e11.4))') nodeprint(i),
     &              (v(j,nodeprint(i)),j=1,3)
            enddo
         endif
!
         if(noelplab(2).eq.'NT  ') then
            write(5,*)
            write(5,*) 'temperature'
            write(5,*)
            if(ithermal.le.1) then
               do i=1,noprint
                  write(5,'(i5,1x,1p,e11.4)') nodeprint(i),
     &                 t1(nodeprint(i))
               enddo
            else
               do i=1,noprint
                  write(5,'(i5,1x,1p,e11.4)') nodeprint(i),
     &                 vold(0,nodeprint(i))
               enddo
            endif
         endif
         
!
         if(noelplab(5).eq.'RF  ') then
            write(5,*)
            write(5,*) 'forces (fx,fy,fz)'
            write(5,*)
            do i=1,noprint
               write(5,'(i5,1p,3(1x,e11.4))') nodeprint(i),
     &              (fn(j,nodeprint(i)),j=1,3)
            enddo
         endif
      endif
!
!     elemental printing requests
!
      write(*,*) 'Printing element quantities'
      write(*,*)
!
      if(neprint.ne.0) then
         if(noelplab(3).eq.'S   ') then
            write(5,*)
            write(5,*) 
     &         'stresses (elem, integ.pnt.,sxx,syy,szz,sxy,sxz,syz)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 (stx(k,j,nelem),k=1,6)
               enddo
            enddo
         endif
!
         if(noelplab(4).eq.'E   ') then
            write(5,*)
            write(5,*) 
     &         'strains (elem, integ.pnt.,exx,eyy,ezz,exy,exz,eyz)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 (eei(k,j,nelem),k=1,6)
               enddo
            enddo
         endif
!
         if(noelplab(6).eq.'PE  ') then
            write(5,*)
            write(5,*) 
     &         'equivalent plastic strain (elem, integ.pnt.,pe)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 xstate(1,j,nelem)
               enddo
            enddo
         endif
!
         if(noelplab(7).eq.'ENER') then
            write(5,*)
            write(5,*) 
     &         'energy density (elem, integ.pnt.,energy)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 ener(j,nelem)
               enddo
            enddo
         endif
!
         if(noelplab(8).eq.'SDV ') then
            do l=1,(nstate_+5)/6
               lb=(l-1)*6
               write(5,*)
               if(l.eq.(nstate_+5)/6) then
                  write(5,300) (lb+k,k=1,nstate_-lb)
               else
                  write(5,300) (lb+k,k=1,6)
               endif
 300           format('internal state variables (elem, integ.pnt.)',
     &             6(i2))
               write(5,*)
               do i=1,neprint
                  nelem=nelemprint(i)
                  if(ipkon(nelem).lt.0) cycle
                  if(lakon(nelem)(4:5).eq.'8R') then
                     mint3d=1
                  elseif((lakon(nelem)(4:4).eq.'8').or.
     &                    (lakon(nelem)(4:6).eq.'20R')) then
                     mint3d=8
                  elseif(lakon(nelem)(4:4).eq.'2') then
                     mint3d=27
                  elseif(lakon(nelem)(4:5).eq.'10') then
                     mint3d=4
                  elseif(lakon(nelem)(4:4).eq.'4') then
                     mint3d=1
                  elseif(lakon(nelem)(4:5).eq.'15') then
                     mint3d=9
                  else
                     mint3d=2
                  endif
                  do j=1,mint3d
                     if(l.eq.(nstate_+5)/6) then
                        write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                       (xstate(lb+k,j,nelem),k=1,nstate_-lb)
                     else
                        write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                       (xstate(lb+k,j,nelem),k=1,6)
                     endif
                  enddo
               enddo
            enddo
         endif
!
      endif
!
!     determining the stresses in the nodes for output in frd format
!
      if(nodeflab(3).eq.'S   ') then
         nfield=6
         ndim=6
         call extrapolate(stx,stn,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the strains in the nodes for output in frd format
!
      if(nodeflab(4).eq.'E   ') then
         nfield=6
         ndim=6
         call extrapolate(eei,een,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the plastic equivalent strain in the nodes 
!     for output in frd format
!
      if(nodeflab(6).eq.'PE  ') then
         nfield=1
         ndim=nstate_
         call extrapolate(xstate,epn,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the total energy in the nodes 
!     for output in frd format
!
      if(nodeflab(7).eq.'ENER') then
         nfield=1
         ndim=1
         call extrapolate(ener,enern,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the internal state variables in the nodes 
!     for output in frd format
!
      if(nodeflab(8).eq.'SDV ') then
         nfield=nstate_
         ndim=nstate_
         call extrapolate(xstate,xstaten,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     if neither stresses nor strains are requested: calculate
!     inum: used in subroutine frd to determine which nodes are
!     active in the model (there is always frd output, e.g. U or
!     NT; default is U and S)
!
      if((nodeflab(3).ne.'S   ').and.(nodeflab(4).ne.'E   ').and.
     &   (nodeflab(6).ne.'PE  ').and.(nodeflab(7).ne.'ENER').and.
     &   (nodeflab(8).ne.'SDV ')) then
!
         do i=1,nk
            inum(i)=0
         enddo
!
         do i=1,ne
!
            if(ipkon(i).lt.0) cycle
            indexe=ipkon(i)
            if(lakon(i)(1:4).eq.'C3D1') then
               nopev=4
            else
               nopev=8
            endif
!
            do j=1,nopev
               inum(kon(indexe+j))=inum(kon(indexe+j))+1
            enddo
         enddo
!
!        determining the midside nodes
!
         do i=1,ne
!
            if(ipkon(i).lt.0) cycle
            indexe=ipkon(i)
            if(lakon(i)(4:4).eq.'2') then
               nope=20
               nopev=8
            elseif(lakon(i)(4:4).eq.'8') then
               nope=8
               nopev=8
            elseif(lakon(i)(4:5).eq.'10') then
               nope=10
               nopev=4
            elseif(lakon(i)(4:4).eq.'4') then
               nope=4
               nopev=4
            elseif(lakon(i)(4:5).eq.'15') then
               nope=15
               nopev=6
            else
               nope=6
               nopev=6
            endif
!
            do j=nopev,nope
               if(inum(kon(indexe+j)).eq.0) inum(kon(indexe+j))=-1
            enddo
         enddo
      endif
!
      return
      end

invivoresults_results__1301

Real time: 4.682592e+06 -- Predicted time: 1.284400e+05

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	1.284400e+05	4.781560e+06	97.3

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_sortAndCompress_IV2DVsortUpAndCompress_339

Real time: 3.298192e+06 -- Predicted time: 3.343572e+06

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	3.343572e+06	3.358316e+06	0.4

                !
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nelemprint,
     &  neprint,stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
     &  ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,prestr,
     &  iprestr,noelplab,nodeflab,eei,een,iperturb,f,fn,
     &  nactdof,iout,qa,noprint,nodeprint,vold,b,nodeboun,ndirboun,
     &  xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,vmax,neq,
     &  veold,accold,bet,gam,dtime,plicon,nplicon,plkcon,nplkcon,
     &  xstateini,xstiff,xstate,npmat_,epn,matname,mint_,ielas,icmd,
     &  ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,sti,
     &  xstaten,eeiini,enerini,cocon,ncocon)
!
!     calculates and prints the displacements, temperatures and forces 
!     at the nodes and the stress and  strain  at the reduced integration 
!     points and at the nodes
!
!     iout=-1: v is assumed to be known and is used to
!              calculate strains, stresses..., no result output
!     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
!
      implicit none
!
      logical calcul_fn,calcul_f,calcul_cauchy,calcul_qa,cauchy
!
      character*4 noelplab(*),nodeflab(*)
      character*8 lakon(*)
      character*20 amat,matname(*),labmpc(*)
!
      integer kon(*),konl(20),inum(*),nelemprint(*),
     &  nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(*),ielorien(*),
     &  ntmat_,ipkon(*),nactdof(0:3,*),nodeprint(*),nodeboun(*),
     &  ndirboun(*),ipompc(*),nodempc(3,*),nelem,ikboun(*),ilboun(*),
     &  ncocon(2,*)
!
      integer nk,ne,neprint,mattyp,ithermal,iprestr,i,j,k,m1,m2,jj,
     &  i1,m3,m4,kk,iener,indexe,nope,norien,iperturb,iout,noprint,
     &  nal,icmd,ihyper,nboun,nmpc,nmethod,ist,ndir,node,index,
     &  neq,kode,imat,mint3d,mint_,nopev,nfield,ndim,iorien,ielas,
     &  istiff,icmdl,ncmat_,nstate_,incrementalmpc,lb,l,jmin,jmax
!
      integer nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
      real*8 co(3,*),v(0:3,*),shp(4,20),stiini(6,mint_,*),
     &  stx(6,mint_,*),stn(6,*),xl(3,20),vl(0:3,20),stre(9),
     &  elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),
     &  alcon(0:6,ntmat_,*),vini(0:3,*),
     &  alzero(*),orab(7,*),elas(21),alph(6),rho,f(*),fn(0:3,*),
     &  skl(3,3),anisox(3,3,3,3),beta(6),q(0:3,20),vkl(0:3,3),
     &  t0(*),t1(*),prestr(6,*),eei(6,mint_,*),een(6,*),ckl(3,3),
     &  vold(0:3,*),b(*),xboun(*),coefmpc(*),vmax,eloc(9),veold(0:3,*),
     &  accold(0:3,*),elconloc(21),eth(6),xkl(3,3),voldl(0:3,20),epn(*),
     &  xikl(3,3),ener(mint_,*),enern(*),sti(6,mint_,*),
     &  eeiini(6,mint_,*),enerini(mint_,*),cocon(0:6,ntmat_,*)
!
      real*8 e,un,al,um,am1,am2,xi,et,ze,tt,exx,eyy,ezz,exy,exz,eyz,
     &  xsj,qa,vj,t0l,t1l,bet,gam,dtime,forcempc,scal1,scal2,bnac,
     &  fixed_disp,weight,pgauss(3),vij,xkapp(6)
!
      real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
     &  xstiff(21,mint_,*),xstate(nstate_,mint_,*),plconloc(82),
     &  vokl(3,3),xstateini(nstate_,mint_,*),vikl(3,3),
     &  xstaten(nstate_,*)
!
      real*8 gauss2d1(2,1),gauss2d2(2,4),gauss2d3(2,9),gauss2d4(2,1),
     &  gauss2d5(2,3),gauss3d1(3,1),gauss3d2(3,8),gauss3d3(3,27),
     &  gauss3d4(3,1),gauss3d5(3,4),gauss3d6(3,15),gauss3d7(3,2),
     &  gauss3d8(3,9),gauss3d9(3,18),weight2d1(1),weight2d2(4),
     &  weight2d3(9),weight2d4(1),weight2d5(3),weight3d1(1),
     &  weight3d2(8),weight3d3(27),weight3d4(1),weight3d5(4),
     &  weight3d6(15),weight3d7(2),weight3d8(9),weight3d9(18)
!
      include "gauss.f"
!
      if(ithermal.le.1) then
         jmin=1
         jmax=3
      elseif(ithermal.eq.2) then
         jmin=0
         jmax=0
      else
         jmin=0
         jmax=3
      endif
!
      if((iout.ne.2).and.(iout.ne.-1)) then
!
         if((nmethod.ne.4).or.(iperturb.le.1)) then
!
!     extracting the displacement information from the solution
!
            do i=1,nk
               do j=jmin,jmax
                  if(nactdof(j,i).ne.0) then
                     v(j,i)=b(nactdof(j,i))
                  else
                     v(j,i)=0.d0
                  endif
               enddo
            enddo
!
!     for static perturbation steps v represents the incremental
!     displacements. For the total displacement vold must be added.
!
            if((iperturb.ne.0).and.(nmethod.eq.1)) then
               vmax=0.d0
               do i=1,nk
                  do j=jmin,jmax
                     vmax=max(vmax,dabs(v(j,i)))
c                     write(*,*) i,j,vold(j,i),v(j,i),vmax
                     v(j,i)=v(j,i)+vold(j,i)
                  enddo
               enddo
            endif
!
         else
!
!           direct integration dynamic step
!           b contains the acceleration increment
!
            if((ithermal.le.1).or.(ithermal.eq.3)) then
               scal1=bet*dtime*dtime
               scal2=gam*dtime
               vmax=0.d0
               do i=1,nk
                  do j=1,3
                     if(nactdof(j,i).ne.0) then
                        bnac=b(nactdof(j,i))
                        v(j,i)=vold(j,i)+scal1*bnac
                        vmax=max(vmax,dabs(scal1*bnac))
                        veold(j,i)=veold(j,i)+scal2*bnac
                        accold(j,i)=accold(j,i)+bnac
                     endif
                  enddo
               enddo
            endif
            if(ithermal.ge.2) then
               do i=1,nk
                  if(nactdof(0,i).ne.0) then
                     bnac=b(nactdof(0,i))
                     v(0,i)=vold(0,i)+bnac
                     vmax=max(vmax,dabs(bnac))
                     veold(0,i)=veold(0,i)+bnac/dtime
                  endif
               enddo
            endif
         endif
!
      endif
!
!        initialization
!
      calcul_fn=.false.
      calcul_f=.false.
      calcul_qa=.false.
      calcul_cauchy=.false.
!

!     determining which quantities have to be calculated
!
      if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.0))) then
         if(iout.lt.1) then
            calcul_fn=.true.
            calcul_f=.true.
            calcul_qa=.true.
         else    
            calcul_cauchy=.true.
         endif
      endif
      if(((noelplab(5).eq.'RF').or.(nodeflab(5).eq.'RF'))
     &     .and.(iout.gt.0)) calcul_fn=.true.
!
!     initializing fn
!
      if(calcul_fn) then
         do i=1,nk
            do j=1,3
               fn(j,i)=0.d0
            enddo
         enddo
      endif
!
!     initializing f
!
      if(calcul_f) then
         do i=1,neq
            f(i)=0.d0
         enddo
      endif
!
!     inserting the boundary conditions
!
      do i=1,nboun
         if(ndirboun(i).gt.3) cycle
         fixed_disp=xboun(i)
         if((nmethod.eq.4).and.(iperturb.gt.1)) then
            ndir=ndirboun(i)
            node=nodeboun(i)
            accold(ndir,node)=(xboun(i)-v(ndir,node))/
     &        (bet*dtime*dtime)
            veold(ndir,node)=veold(ndir,node)+
     &        gam*dtime*accold(ndir,node)
         endif
         v(ndirboun(i),nodeboun(i))=fixed_disp
c         write(*,*) 'boun ',nodeboun(i),ndirboun(i),fixed_disp
      enddo
!
!     inserting the mpc information
!     the parameter incrementalmpc indicates whether the
!     incremental displacements enter the mpc or the total 
!     displacements (incrementalmpc=0)
!
      do i=1,nmpc
         if((labmpc(i)(1:20).eq.'                    ').or.
     &      (labmpc(i)(1:6).eq.'CYCLIC').or.
     &      (labmpc(i)(1:5).eq.'RIGID').or.
     &      (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
            incrementalmpc=0
         else
            incrementalmpc=1
         endif
         ist=ipompc(i)
         node=nodempc(1,ist)
         ndir=nodempc(2,ist)
         index=nodempc(3,ist)
         fixed_disp=0.d0
         if(index.ne.0) then
            do
               if(incrementalmpc.eq.0) then
                  fixed_disp=fixed_disp-coefmpc(index)*
     &                 v(nodempc(2,index),nodempc(1,index))
               else
c                  write(*,102) 
c     &             nodempc(1,index),nodempc(2,index),
c     &             v(nodempc(2,index),nodempc(1,index)),
c     &             vold(nodempc(2,index),nodempc(1,index))
c 102              format('results,node,dir,newvalue,oldvalue',2i5,
c     &                2(1x,e11.4))
                  fixed_disp=fixed_disp-coefmpc(index)*
     &                 (v(nodempc(2,index),nodempc(1,index))-
     &                  vold(nodempc(2,index),nodempc(1,index)))
c                  write(*,*) fixed_disp,
c     & vold(nodempc(2,index),nodempc(1,index)),
c     & v(nodempc(2,index),nodempc(1,index))
               endif
               index=nodempc(3,index)
               if(index.eq.0) exit
            enddo
         endif
         fixed_disp=fixed_disp/coefmpc(ist)
c                  write(*,*) fixed_disp
         if(incrementalmpc.eq.1) then
            fixed_disp=fixed_disp+vold(ndir,node)
c            write(*,*) 'results ',i,vold(ndir,node),fixed_disp
         endif
         if((nmethod.eq.4).and.(iperturb.gt.1)) then
            accold(ndir,node)=(fixed_disp-v(ndir,node))/
     &        (bet*dtime*dtime)
            veold(ndir,node)=veold(ndir,node)+
     &        gam*dtime*accold(ndir,node)
         endif
         v(ndir,node)=fixed_disp
c         write(*,102) node,ndir,v(ndir,node),vold(ndir,node)
      enddo
!
!     check whether there are any strain output requests
!
      if ((noelplab(7).eq.'ENER').or.(nodeflab(7).eq.'ENER')) then
         iener=1
      else
         iener=0
      endif
!
      qa=0.d0
      nal=0
!
!     calculation of the stresses in the integration points
! 
      if((ithermal.le.1).or.(ithermal.eq.3)) then
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         imat=ielmat(i)
         amat=matname(imat)
         if(norien.gt.0) then
            iorien=ielorien(i)
         else
            iorien=0
         endif
!
c         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         if(lakon(i)(4:4).eq.'2') then
            nope=20
         elseif(lakon(i)(4:4).eq.'8') then
            nope=8
         elseif(lakon(i)(4:5).eq.'10') then
            nope=10
         elseif(lakon(i)(4:4).eq.'4') then
            nope=4
         elseif(lakon(i)(4:5).eq.'15') then
            nope=15
         else
            nope=6
         endif
!
         if(lakon(i)(4:5).eq.'8R') then
            mint3d=1
         elseif((lakon(i)(4:4).eq.'8').or.
     &          (lakon(i)(4:6).eq.'20R')) then
            mint3d=8
         elseif(lakon(i)(4:4).eq.'2') then
            mint3d=27
         elseif(lakon(i)(4:5).eq.'10') then
            mint3d=4
         elseif(lakon(i)(4:4).eq.'4') then
            mint3d=1
         elseif(lakon(i)(4:5).eq.'15') then
            mint3d=9
         else
            mint3d=2
         endif
!
         do j=1,nope
            konl(j)=kon(indexe+j)
            do k=1,3
               xl(k,j)=co(k,konl(j))
               vl(k,j)=v(k,konl(j))
               voldl(k,j)=vold(k,konl(j))
            enddo
         enddo
!
!        check for hyperelastic material
!
         if(nelcon(1,imat).lt.0) then
            ihyper=1
         else
            ihyper=0
         endif
!
!        q contains the nodal forces per element; initialisation of q
!
         if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.1))) then
            do m1=1,nope
               do m2=1,3
                  q(m2,m1)=fn(m2,konl(m1))
               enddo
            enddo
         endif
!
         do jj=1,mint3d
            if(lakon(i)(4:5).eq.'8R') then
               xi=gauss3d1(1,jj)
               et=gauss3d1(2,jj)
               ze=gauss3d1(3,jj)
               weight=weight3d1(jj)
            elseif((lakon(i)(4:4).eq.'8').or.
     &             (lakon(i)(4:6).eq.'20R'))
     &        then
               xi=gauss3d2(1,jj)
c               if(nope.eq.20) xi=xi+1.d0
               et=gauss3d2(2,jj)
               ze=gauss3d2(3,jj)
               weight=weight3d2(jj)
            elseif(lakon(i)(4:4).eq.'2') then
c               xi=gauss3d3(1,jj)+1.d0
               xi=gauss3d3(1,jj)
               et=gauss3d3(2,jj)
               ze=gauss3d3(3,jj)
               weight=weight3d3(jj)
            elseif(lakon(i)(4:5).eq.'10') then
               xi=gauss3d5(1,jj)
               et=gauss3d5(2,jj)
               ze=gauss3d5(3,jj)
               weight=weight3d5(jj)
            elseif(lakon(i)(4:4).eq.'4') then
               xi=gauss3d4(1,jj)
               et=gauss3d4(2,jj)
               ze=gauss3d4(3,jj)
               weight=weight3d4(jj)
            elseif(lakon(i)(4:5).eq.'15') then
               xi=gauss3d8(1,jj)
               et=gauss3d8(2,jj)
               ze=gauss3d8(3,jj)
               weight=weight3d8(jj)
            else
               xi=gauss3d7(1,jj)
               et=gauss3d7(2,jj)
               ze=gauss3d7(3,jj)
               weight=weight3d7(jj)
            endif
!
            if(nope.eq.20) then
               call shape20h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.8) then
               call shape8h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.10) then
               call shape10tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.4) then
               call shape4tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.15) then
               call shape15w(xi,et,ze,xl,xsj,shp)
            else
               call shape6w(xi,et,ze,xl,xsj,shp)
            endif
!
!                 vkl(m2,m3) contains the derivative of the m2-
!                 component of the displacement with respect to
!                 direction m3
!
            do m2=1,3
               do m3=1,3
                  vkl(m2,m3)=0.d0
               enddo
            enddo
!
            do m1=1,nope
               do m2=1,3
                  do m3=1,3
                     vkl(m2,m3)=vkl(m2,m3)+shp(m3,m1)*vl(m2,m1)
                  enddo
               enddo
            enddo
!
            kode=nelcon(1,imat)
!
!                 calculating the strain
!
!                 attention! exy,exz and eyz are engineering strains!
!
            exx=vkl(1,1)
            eyy=vkl(2,2)
            ezz=vkl(3,3)
            exy=vkl(1,2)+vkl(2,1)
            exz=vkl(1,3)+vkl(3,1)
            eyz=vkl(2,3)+vkl(3,2)
!
!                 Lagrangian/Eulerian strain tensor for geometric
!                 nonlinear calculations
!
            if(iperturb.ge.2) then
!
!                    Lagrangian strain
!
               exx=exx+(vkl(1,1)**2+vkl(2,1)**2+vkl(3,1)**2)/2.d0
               eyy=eyy+(vkl(1,2)**2+vkl(2,2)**2+vkl(3,2)**2)/2.d0
               ezz=ezz+(vkl(1,3)**2+vkl(2,3)**2+vkl(3,3)**2)/2.d0
               exy=exy+vkl(1,1)*vkl(1,2)+vkl(2,1)*vkl(2,2)+
     &              vkl(3,1)*vkl(3,2)
               exz=exz+vkl(1,1)*vkl(1,3)+vkl(2,1)*vkl(2,3)+
     &              vkl(3,1)*vkl(3,3)
               eyz=eyz+vkl(1,2)*vkl(1,3)+vkl(2,2)*vkl(2,3)+
     &              vkl(3,2)*vkl(3,3)
!
            endif
!
!                 storing the local strains
!
            if((iperturb.ne.0).or.(iout.ge.0)) then
               eloc(1)=exx
               eloc(2)=eyy
               eloc(3)=ezz
               eloc(4)=exy/2.d0
               eloc(5)=exz/2.d0
               eloc(6)=eyz/2.d0
            else
!
!                    linear iteration within a nonlinear increment:
!                    tangent matrix is calculated at strain at
!                    the end of the previous increment
!
               do m1=1,6
                  eloc(m1)=eei(m1,jj,i)
               enddo
            endif
!
!                 calculating the deformation gradient (needed to
!                 convert the element stiffness matrix from spatial
!                 coordinates to material coordinates
!                 deformation plasticity)
!
            if((kode.eq.-50).or.(kode.le.-100)) then
!
!                    calculating the deformation gradient
!
               xkl(1,1)=vkl(1,1)+1
               xkl(2,2)=vkl(2,2)+1.
               xkl(3,3)=vkl(3,3)+1.
               xkl(1,2)=vkl(1,2)
               xkl(1,3)=vkl(1,3)
               xkl(2,3)=vkl(2,3)
               xkl(2,1)=vkl(2,1)
               xkl(3,1)=vkl(3,1)
               xkl(3,2)=vkl(3,2)
!
!                    calculating the Jacobian
!
               vj=xkl(1,1)*(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))
     &              -xkl(1,2)*(xkl(2,1)*xkl(3,3)-xkl(2,3)*xkl(3,1))
     &              +xkl(1,3)*(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))
!
!              inversion of the deformation gradient (only for
!              deformation plasticity)
!
               if(kode.eq.-50) then
!
                  ckl(1,1)=(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))/vj
                  ckl(2,2)=(xkl(1,1)*xkl(3,3)-xkl(1,3)*xkl(3,1))/vj
                  ckl(3,3)=(xkl(1,1)*xkl(2,2)-xkl(1,2)*xkl(2,1))/vj
                  ckl(1,2)=(xkl(1,3)*xkl(3,2)-xkl(1,2)*xkl(3,3))/vj
                  ckl(1,3)=(xkl(1,2)*xkl(2,3)-xkl(2,2)*xkl(1,3))/vj
                  ckl(2,3)=(xkl(2,1)*xkl(1,3)-xkl(1,1)*xkl(2,3))/vj
                  ckl(2,1)=(xkl(3,1)*xkl(2,3)-xkl(2,1)*xkl(3,3))/vj
                  ckl(3,1)=(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))/vj
                  ckl(3,2)=(xkl(3,1)*xkl(1,2)-xkl(1,1)*xkl(3,2))/vj
!
!                 converting the Lagrangian strain into Eulerian
!                 strain (only for deformation plasticity)
!
                  cauchy=.false.
                  call str2mat(eloc,ckl,vj,cauchy)
               endif
!                        
            endif
!
!                 calculating fields for incremental plasticity
!
            if(kode.le.-100) then
!
!              calculating the deformation gradient at the
!              start of the increment
!
!              calculating the displacement gradient at the
!              start of the increment
!
               do m2=1,3
                  do m3=1,3
                     vikl(m2,m3)=0.d0
                  enddo
               enddo
!
               do m1=1,nope
                  do m2=1,3
                     do m3=1,3
                        vikl(m2,m3)=vikl(m2,m3)
     &                       +shp(m3,m1)*vini(m2,konl(m1))
                     enddo
                  enddo
               enddo
!
!              calculating the deformation gradient of the old
!              fields
!
               xikl(1,1)=vikl(1,1)+1
               xikl(2,2)=vikl(2,2)+1.
               xikl(3,3)=vikl(3,3)+1.
               xikl(1,2)=vikl(1,2)
               xikl(1,3)=vikl(1,3)
               xikl(2,3)=vikl(2,3)
               xikl(2,1)=vikl(2,1)
               xikl(3,1)=vikl(3,1)
               xikl(3,2)=vikl(3,2)
!
!              calculating the Jacobian
!
               vij=xikl(1,1)*(xikl(2,2)*xikl(3,3)
     &              -xikl(2,3)*xikl(3,2))
     &              -xikl(1,2)*(xikl(2,1)*xikl(3,3)
     &              -xikl(2,3)*xikl(3,1))
     &              +xikl(1,3)*(xikl(2,1)*xikl(3,2)
     &              -xikl(2,2)*xikl(3,1))
!
!              stresses at the start of the increment
!
               do m1=1,6
                  stre(m1)=stiini(m1,jj,i)
               enddo
!
            endif
!
!                 prestress values
!
            if(iprestr.eq.0) then
               do kk=1,6
                  beta(kk)=0.d0
               enddo
            else
               do kk=1,6
                  beta(kk)=-prestr(kk,i)
               enddo
            endif
!
            if(ithermal.ge.1) then
!
!              calculating the temperature difference in
!              the integration point
!
               t0l=0.d0
               t1l=0.d0
               if(ithermal.eq.1) then
                  if(lakon(i)(4:5).eq.'8 ') then
                     do i1=1,nope
                        t0l=t0l+t0(konl(i1))/8.d0
                        t1l=t1l+t1(konl(i1))/8.d0
                     enddo
                  elseif(lakon(i)(4:6).eq.'20 ') then
                     call lintemp(t0,t1,konl,nope,jj,t0l,t1l)
                  else
                     do i1=1,nope
                        t0l=t0l+shp(4,i1)*t0(konl(i1))
                        t1l=t1l+shp(4,i1)*t1(konl(i1))
                     enddo
                  endif
               elseif(ithermal.ge.2) then
                  if(lakon(i)(4:5).eq.'8 ') then
                     do i1=1,nope
                        t0l=t0l+t0(konl(i1))/8.d0
                        t1l=t1l+vold(0,konl(i1))/8.d0
                     enddo
                  elseif(lakon(i)(4:6).eq.'20 ') then
                     call lintemp_th(t0,vold,konl,nope,jj,t0l,t1l)
                  else
                     do i1=1,nope
                        t0l=t0l+shp(4,i1)*t0(konl(i1))
                        t1l=t1l+shp(4,i1)*vold(0,konl(i1))
                     enddo
                  endif
               endif
               tt=t1l-t0l
            endif
!
!                 calculating the coordinates of the integration point
!                 for material orientation purposes (for cylindrical
!                 coordinate systems)
!
            if(iorien.gt.0) then
               do j=1,3
                  pgauss(j)=0.d0
                  do i1=1,nope
                     pgauss(j)=pgauss(j)+shp(4,i1)*co(j,konl(i1))
                  enddo
               enddo
            endif
!
!                 material data; for linear elastic materials
!                 this includes the calculation of the stiffness
!                 matrix
!
            istiff=0
!
            call materialdata(elcon,nelcon,rhcon,nrhcon,alcon,
     &           nalcon,imat,amat,iorien,pgauss,orab,ntmat_,
     &           elas,alph,rho,i,ithermal,alzero,mattyp,
     &           t0l,t1l,ihyper,istiff,
     &           elconloc,eth,kode,plicon,nplicon,
     &           plkcon,nplkcon,npmat_,
     &           plconloc,mint_,dtime,i,jj,
     &           xstiff,ncmat_)
!
            if((ihyper.eq.0).and.
     &           ((iperturb.ne.0).or.(iout.ge.0))) then
               if(mattyp.eq.1) then
                  e=elas(1)
                  un=elas(2)
                  al=un*e/(1.d0+un)/(1.d0-2.d0*un)
                  um=e/2.d0/(1.d0+un)
                  am1=al+2.d0*um
                  am2=2.d0*um
               elseif(mattyp.eq.3) then
                  call anisotropic(elas,anisox)
               endif
!
               icmdl=3
               call linel(ithermal,mattyp,beta,al,um,am1,alph,tt,
     &              elas,icmdl,exx,eyy,ezz,exy,exz,eyz,stre,
     &              anisox)
!
            elseif(ihyper.ne.0) then
               mattyp=3
               call hyperel(elconloc,elas,eloc,kode,eth,ithermal,
     &              icmd,beta,stre,xkl,ckl,vj,xikl,vij,
     &              plconloc,xstate,xstateini,ielas,
     &              amat,t1l,dtime,i,jj,nstate_,mint_,
     &              iorien,pgauss,orab)
               do m1=1,21
                  xstiff(m1,jj,i)=elas(m1)
               enddo
            endif
!
            if((iperturb.eq.0).and.(iout.lt.0)) then
!
!                    if the forced displacements were changed at
!                    the start of a nonlinear step, the nodal
!                    forces due do this displacements are 
!                    calculated in a purely linear way, and
!                    the first iteration is purely linear in order
!                    to allow the displacements to redistribute
!                    in a quasi-static way (only applies to
!                    quasi-static analyses (*STATIC))
!
               do m2=1,3
                  do m3=1,3
                     vokl(m2,m3)=0.d0
                  enddo
               enddo
!
               do m1=1,nope
                  do m2=1,3
                     do m3=1,3
                        vokl(m2,m3)=vokl(m2,m3)+
     &                       shp(m3,m1)*voldl(m2,m1)
                     enddo
                  enddo
               enddo
!
               eloc(1)=exx-vokl(1,1)
               eloc(2)=eyy-vokl(2,2)
               eloc(3)=ezz-vokl(3,3)
               eloc(4)=exy-(vokl(1,2)+vokl(2,1))
               eloc(5)=exz-(vokl(1,3)+vokl(3,1))
               eloc(6)=eyz-(vokl(2,3)+vokl(3,2))
               if(mattyp.eq.1) then
                  e=elas(1)
                  un=elas(2)
                  um=e/(1.d0+un)
                  al=un*um/(1.d0-2.d0*un)
                  um=um/2.d0
                  am1=al*(eloc(1)+eloc(2)+eloc(3))
                  stre(1)=am1+2.d0*um*eloc(1)
                  stre(2)=am1+2.d0*um*eloc(2)
                  stre(3)=am1+2.d0*um*eloc(3)
                  stre(4)=um*eloc(4)
                  stre(5)=um*eloc(5)
                  stre(6)=um*eloc(6)
               elseif(mattyp.eq.2) then
                  stre(1)=eloc(1)*elas(1)+eloc(2)*elas(2)
     &                 +eloc(3)*elas(4)
                  stre(2)=eloc(1)*elas(2)+eloc(2)*elas(3)
     &                 +eloc(3)*elas(5)
                  stre(3)=eloc(1)*elas(4)+eloc(2)*elas(5)
     &                 +eloc(3)*elas(6)
                  stre(4)=eloc(4)*elas(7)
                  stre(5)=eloc(5)*elas(8)
                  stre(6)=eloc(6)*elas(9)
               elseif(mattyp.eq.3) then
                  stre(1)=eloc(1)*elas(1)+eloc(2)*elas(2)+
     &                 eloc(3)*elas(4)+eloc(4)*elas(7)+
     &                 eloc(5)*elas(11)+eloc(6)*elas(16)
                  stre(2)=eloc(1)*elas(2)+eloc(2)*elas(3)+
     &                 eloc(3)*elas(5)+eloc(4)*elas(8)+
     &                 eloc(5)*elas(12)+eloc(6)*elas(17)
                  stre(3)=eloc(1)*elas(4)+eloc(2)*elas(5)+
     &                 eloc(3)*elas(6)+eloc(4)*elas(9)+
     &                 eloc(5)*elas(13)+eloc(6)*elas(18)
                  stre(4)=eloc(1)*elas(7)+eloc(2)*elas(8)+
     &                 eloc(3)*elas(9)+eloc(4)*elas(10)+
     &                 eloc(5)*elas(14)+eloc(6)*elas(19)
                  stre(5)=eloc(1)*elas(11)+eloc(2)*elas(12)+
     &                 eloc(3)*elas(13)+eloc(4)*elas(14)+
     &                 eloc(5)*elas(15)+eloc(6)*elas(20)
                  stre(6)=eloc(1)*elas(16)+eloc(2)*elas(17)+
     &                 eloc(3)*elas(18)+eloc(4)*elas(19)+
     &                 eloc(5)*elas(20)+eloc(6)*elas(21)
               endif
            endif
! 
!           updating the energy
!
            if(iener.eq.1) then
               ener(jj,i)=enerini(jj,i)+
     &           ((eloc(1)-eeiini(1,jj,i))*(stre(1)+stiini(1,jj,i))+
     &            (eloc(2)-eeiini(2,jj,i))*(stre(2)+stiini(2,jj,i))+
     &            (eloc(3)-eeiini(3,jj,i))*(stre(3)+stiini(3,jj,i)))
     &            /2.d0+
     &            (eloc(4)-eeiini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
     &            (eloc(5)-eeiini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
     &            (eloc(6)-eeiini(6,jj,i))*(stre(6)+stiini(6,jj,i))
c               write(*,*) 'energy',jj,i,ener(jj,i)
            endif
!
            eei(1,jj,i)=eloc(1)
            eei(2,jj,i)=eloc(2)
            eei(3,jj,i)=eloc(3)
            eei(4,jj,i)=eloc(4)
            eei(5,jj,i)=eloc(5)
            eei(6,jj,i)=eloc(6)
!
            skl(1,1)=stre(1)
            skl(2,2)=stre(2)
            skl(3,3)=stre(3)
            skl(2,1)=stre(4)
            skl(3,1)=stre(5)
            skl(3,2)=stre(6)
!
            stx(1,jj,i)=skl(1,1)
            stx(2,jj,i)=skl(2,2)
            stx(3,jj,i)=skl(3,3)
            stx(4,jj,i)=skl(2,1)
            stx(5,jj,i)=skl(3,1)
            stx(6,jj,i)=skl(3,2)
!
            skl(1,2)=skl(2,1)
            skl(1,3)=skl(3,1)
            skl(2,3)=skl(3,2)
!
!                 calculation of the nodal forces
!
            if(calcul_fn)then
!
!                    calculating fn using skl
!
               do m1=1,nope
                  do m2=1,3
!
!                          linear elastic part
!                           
                     do m3=1,3
                        fn(m2,konl(m1))=fn(m2,konl(m1))+
     &                       xsj*skl(m2,m3)*shp(m3,m1)*weight
                     enddo
!
!                          nonlinear geometric part
!
                     if(iperturb.ge.2) then
                        do m3=1,3
                           do m4=1,3
                              fn(m2,konl(m1))=fn(m2,konl(m1))+
     &                             xsj*skl(m4,m3)*weight*
     &                             (vkl(m2,m4)*shp(m3,m1)+
     &                             vkl(m2,m3)*shp(m4,m1))/2.d0
                           enddo
                        enddo
                     endif
!
                  enddo
               enddo
            endif
!
!           calculation of the Cauchy stresses
!
            if(calcul_cauchy) then
!
!              changing the displacement gradients into
!              deformation gradients
!
               if(kode.ne.-50) then
                  xkl(1,1)=vkl(1,1)+1
                  xkl(2,2)=vkl(2,2)+1.
                  xkl(3,3)=vkl(3,3)+1.
                  xkl(1,2)=vkl(1,2)
                  xkl(1,3)=vkl(1,3)
                  xkl(2,3)=vkl(2,3)
                  xkl(2,1)=vkl(2,1)
                  xkl(3,1)=vkl(3,1)
                  xkl(3,2)=vkl(3,2)
!
                  vj=xkl(1,1)*(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))
     &                 -xkl(1,2)*(xkl(2,1)*xkl(3,3)-xkl(2,3)*xkl(3,1))
     &                 +xkl(1,3)*(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))
               endif
!
               do m1=1,3
                  do m2=1,m1
                     ckl(m1,m2)=0.d0
                     do m3=1,3
                        do m4=1,3
                           ckl(m1,m2)=ckl(m1,m2)+
     &                          skl(m3,m4)*xkl(m1,m3)*xkl(m2,m4)
                        enddo
                     enddo
                     ckl(m1,m2)=ckl(m1,m2)/vj
                  enddo
               enddo
!
               stx(1,jj,i)=ckl(1,1)
               stx(2,jj,i)=ckl(2,2)
               stx(3,jj,i)=ckl(3,3)
               stx(4,jj,i)=ckl(2,1)
               stx(5,jj,i)=ckl(3,1)
               stx(6,jj,i)=ckl(3,2)
            endif
!
         enddo
!
!        q contains the contributions to the nodal force in the nodes
!        belonging to the element at stake from other elements (elements
!        already treated). These contributions have to be
!        subtracted to get the contributions attributable to the element
!        at stake only
!
         if(calcul_qa) then
            do m1=1,nope
               do m2=1,3
                  qa=qa+dabs(fn(m2,konl(m1))-q(m2,m1))
               enddo
            enddo
            nal=nal+3*nope
         endif
      enddo
!
      endif
!
!     calculation of temperatures and thermal flux
!
      if(ithermal.ge.2) then
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         imat=ielmat(i)
         amat=matname(imat)
         if(norien.gt.0) then
            iorien=ielorien(i)
         else
            iorien=0
         endif
!
         indexe=ipkon(i)
         if(lakon(i)(4:4).eq.'2') then
            nope=20
         elseif(lakon(i)(4:4).eq.'8') then
            nope=8
         elseif(lakon(i)(4:5).eq.'10') then
            nope=10
         elseif(lakon(i)(4:4).eq.'4') then
            nope=4
         elseif(lakon(i)(4:5).eq.'15') then
            nope=15
         else
            nope=6
         endif
!
         if(lakon(i)(4:5).eq.'8R') then
            mint3d=1
         elseif((lakon(i)(4:4).eq.'8').or.
     &          (lakon(i)(4:6).eq.'20R')) then
            mint3d=8
         elseif(lakon(i)(4:4).eq.'2') then
            mint3d=27
         elseif(lakon(i)(4:5).eq.'10') then
            mint3d=4
         elseif(lakon(i)(4:4).eq.'4') then
            mint3d=1
         elseif(lakon(i)(4:5).eq.'15') then
            mint3d=9
         else
            mint3d=2
         endif
!
         do j=1,nope
            konl(j)=kon(indexe+j)
            do k=1,3
               xl(k,j)=co(k,konl(j))
            enddo
            vl(0,j)=v(0,konl(j))
            voldl(0,j)=vold(0,konl(j))
         enddo
!
!        q contains the nodal forces per element; initialisation of q
!
         if((iperturb.ge.2).or.((iperturb.eq.0).and.(iout.lt.1))) then
            do m1=1,nope
               q(0,m1)=fn(0,konl(m1))
            enddo
         endif
!
         do jj=1,mint3d
            if(lakon(i)(4:5).eq.'8R') then
               xi=gauss3d1(1,jj)
               et=gauss3d1(2,jj)
               ze=gauss3d1(3,jj)
               weight=weight3d1(jj)
            elseif((lakon(i)(4:4).eq.'8').or.
     &             (lakon(i)(4:6).eq.'20R'))
     &        then
               xi=gauss3d2(1,jj)
               et=gauss3d2(2,jj)
               ze=gauss3d2(3,jj)
               weight=weight3d2(jj)
            elseif(lakon(i)(4:4).eq.'2') then
               xi=gauss3d3(1,jj)
               et=gauss3d3(2,jj)
               ze=gauss3d3(3,jj)
               weight=weight3d3(jj)
            elseif(lakon(i)(4:5).eq.'10') then
               xi=gauss3d5(1,jj)
               et=gauss3d5(2,jj)
               ze=gauss3d5(3,jj)
               weight=weight3d5(jj)
            elseif(lakon(i)(4:4).eq.'4') then
               xi=gauss3d4(1,jj)
               et=gauss3d4(2,jj)
               ze=gauss3d4(3,jj)
               weight=weight3d4(jj)
            elseif(lakon(i)(4:5).eq.'15') then
               xi=gauss3d8(1,jj)
               et=gauss3d8(2,jj)
               ze=gauss3d8(3,jj)
               weight=weight3d8(jj)
            else
               xi=gauss3d7(1,jj)
               et=gauss3d7(2,jj)
               ze=gauss3d7(3,jj)
               weight=weight3d7(jj)
            endif
!
            if(nope.eq.20) then
               call shape20h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.8) then
               call shape8h(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.10) then
               call shape10tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.4) then
               call shape4tet(xi,et,ze,xl,xsj,shp)
            elseif(nope.eq.15) then
               call shape15w(xi,et,ze,xl,xsj,shp)
            else
               call shape6w(xi,et,ze,xl,xsj,shp)
            endif
!
!                 vkl(m2,m3) contains the derivative of the m2-
!                 component of the displacement with respect to
!                 direction m3
!
            do m3=1,3
               vkl(0,m3)=0.d0
            enddo
!
            do m1=1,nope
               do m3=1,3
                  vkl(0,m3)=vkl(0,m3)+shp(m3,m1)*vl(0,m1)
               enddo
            enddo
!
            kode=nelcon(1,imat)
!
!           storing the temperature gradients
!
            eloc(7)=vkl(0,1)
            eloc(8)=vkl(0,2)
            eloc(9)=vkl(0,3)
!
!              calculating the temperature difference in
!              the integration point
!
            t1l=0.d0
            if(lakon(i)(4:5).eq.'8 ') then
               do i1=1,nope
                  t1l=t1l+vold(0,konl(i1))/8.d0
               enddo
            elseif(lakon(i)(4:6).eq.'20 ') then
               call lintemp_th(t0,vold,konl,nope,jj,t0l,t1l)
            else
               do i1=1,nope
                  t1l=t1l+shp(4,i1)*vold(0,konl(i1))
               enddo
            endif
!
!           calculating the coordinates of the integration point
!           for material orientation purposes (for cylindrical
!           coordinate systems)
!
            if(iorien.gt.0) then
               do j=1,3
                  pgauss(j)=0.d0
                  do i1=1,nope
                     pgauss(j)=pgauss(j)+shp(4,i1)*co(j,konl(i1))
                  enddo
               enddo
            endif
!
!                 material data; for linear elastic materials
!                 this includes the calculation of the stiffness
!                 matrix
!
            call matdata_co(cocon,ncocon,imat,iorien,pgauss,orab,ntmat_,
     &           xkapp,mattyp,t1l)
!
            if(mattyp.eq.1) then
               do m1=1,3
                  stre(6+m1)=xkapp(1)*vkl(0,m1)
               enddo
            elseif(mattyp.eq.2) then
               stre(7)=xkapp(1)*vkl(0,1)
               stre(8)=xkapp(2)*vkl(0,2)
               stre(9)=xkapp(3)*vkl(0,3)
            else
               stre(7)=xkapp(1)*vkl(0,1)+xkapp(2)*vkl(0,2)+
     &                 xkapp(4)*vkl(0,3)
               stre(8)=xkapp(2)*vkl(0,1)+xkapp(3)*vkl(0,2)+
     &                 xkapp(5)*vkl(0,3)
               stre(9)=xkapp(4)*vkl(0,1)+xkapp(5)*vkl(0,2)+
     &                 xkapp(6)*vkl(0,3)
            endif
! 
!           updating the energy
!
c            if(iener.eq.1) then
c               ener(jj,i)=enerini(jj,i)+
c     &           ((eloc(1)-eeiini(1,jj,i))*(stre(1)+stiini(1,jj,i))+
c     &            (eloc(2)-eeiini(2,jj,i))*(stre(2)+stiini(2,jj,i))+
c     &            (eloc(3)-eeiini(3,jj,i))*(stre(3)+stiini(3,jj,i)))
c     &            /2.d0+
c     &            (eloc(4)-eeiini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
c     &            (eloc(5)-eeiini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
c     &            (eloc(6)-eeiini(6,jj,i))*(stre(6)+stiini(6,jj,i))
c               write(*,*) 'energy',jj,i,ener(jj,i)
c            endif
!
!           dimension of stx should be 9!!!!!!
!
c            stx(7,jj,i)=skl(1,1)
c            stx(8,jj,i)=skl(2,2)
c            stx(9,jj,i)=skl(3,3)
!
!           calculation of the nodal flux
!
            if(calcul_fn)then
!
!                    calculating fn using skl
!
               do m1=1,nope
                  do m3=1,3
                     fn(0,konl(m1))=fn(0,konl(m1))+
     &                    xsj*stre(m3)*shp(m3,m1)*weight
                  enddo
               enddo
            endif
         enddo
!
!        q contains the contributions to the nodal force in the nodes
!        belonging to the element at stake from other elements (elements
!        already treated). These contributions have to be
!        subtracted to get the contributions attributable to the element
!        at stake only
!
         if(calcul_qa) then
            do m1=1,nope
               do m2=1,3
                  qa=qa+dabs(fn(m2,konl(m1))-q(m2,m1))
               enddo
            enddo
            nal=nal+3*nope
         endif
      enddo
!
      endif
!
      if(calcul_qa) qa=qa/nal
!
!     subtracting the mpc force (for each linear mpc there is one
!     force; the actual force in a node belonging to the mpc is
!     obtained by multiplying this force with the nodal coefficient.
!     The force has to be subtracted from f, since it does not
!     appear on the rhs of the equations system
!
        do i=1,nmpc
            ist=ipompc(i)
            node=nodempc(1,ist)
            ndir=nodempc(2,ist)
            forcempc=fn(ndir,node)/coefmpc(ist)
            fn(ndir,node)=0.d0
            index=nodempc(3,ist)
            if(index.eq.0) cycle
            do
               node=nodempc(1,index)
               ndir=nodempc(2,index)
               fn(ndir,node)=fn(ndir,node)-coefmpc(index)*forcempc
               index=nodempc(3,index)
               if(index.eq.0) exit
            enddo
         enddo
!
!     calculating the system force vector
!
      if(calcul_f) then
         do i=1,nk
            do j=1,3
c               write(*,500) i,j,fn(j,i)
c 500           format(i5,',',i5,',',e11.4)
               if(nactdof(j,i).ne.0) then
                  f(nactdof(j,i))=fn(j,i)
               endif
            enddo
         enddo
!
!     subtracting the mpc force (for each linear mpc there is one
!     force; the actual force in a node belonging to the mpc is
!     obtained by multiplying this force with the nodal coefficient.
!     The force has to be subtracted from f, since it does not
!     appear on the rhs of the equations system
!
c         do i=1,nmpc
c            ist=ipompc(i)
c            node=nodempc(1,ist)
c            ndir=nodempc(2,ist)
c            forcempc=fn(ndir,node)/coefmpc(ist)
c            index=nodempc(3,ist)
c            if(index.eq.0) cycle
c            do
c               node=nodempc(1,index)
c               ndir=nodempc(2,index)
c               j=nactdof(ndir,node)
c
c to be modified for nodes which do not belong to any elements:
c  thus there is no stress and no force is calculated
c  example: rigid body motion
c
c               if(j.ne.0) then
c                  f(j)=f(j)-coefmpc(index)*forcempc
c               endif
c               index=nodempc(3,index)
c               if(index.eq.0) exit
c            enddo
c         enddo
      endif
!
!     no print requests
!
      if(iout.le.0) return
!
!     nodal printing requests
!
      write(*,*) 'Printing nodal quantities'
      write(*,*)
!
      if(noprint.ne.0) then
         if(noelplab(1).eq.'U   ') then
            write(5,*)
            write(5,*) 'displacements (vx,vy,vz)'
            write(5,*)
            do i=1,noprint
               write(5,'(i5,1p,3(1x,e11.4))') nodeprint(i),
     &              (v(j,nodeprint(i)),j=1,3)
            enddo
         endif
!
         if(noelplab(2).eq.'NT  ') then
            write(5,*)
            write(5,*) 'temperature'
            write(5,*)
            if(ithermal.le.1) then
               do i=1,noprint
                  write(5,'(i5,1x,1p,e11.4)') nodeprint(i),
     &                 t1(nodeprint(i))
               enddo
            else
               do i=1,noprint
                  write(5,'(i5,1x,1p,e11.4)') nodeprint(i),
     &                 vold(0,nodeprint(i))
               enddo
            endif
         endif
         
!
         if(noelplab(5).eq.'RF  ') then
            write(5,*)
            write(5,*) 'forces (fx,fy,fz)'
            write(5,*)
            do i=1,noprint
               write(5,'(i5,1p,3(1x,e11.4))') nodeprint(i),
     &              (fn(j,nodeprint(i)),j=1,3)
            enddo
         endif
      endif
!
!     elemental printing requests
!
      write(*,*) 'Printing element quantities'
      write(*,*)
!
      if(neprint.ne.0) then
         if(noelplab(3).eq.'S   ') then
            write(5,*)
            write(5,*) 
     &         'stresses (elem, integ.pnt.,sxx,syy,szz,sxy,sxz,syz)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 (stx(k,j,nelem),k=1,6)
               enddo
            enddo
         endif
!
         if(noelplab(4).eq.'E   ') then
            write(5,*)
            write(5,*) 
     &         'strains (elem, integ.pnt.,exx,eyy,ezz,exy,exz,eyz)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 (eei(k,j,nelem),k=1,6)
               enddo
            enddo
         endif
!
         if(noelplab(6).eq.'PE  ') then
            write(5,*)
            write(5,*) 
     &         'equivalent plastic strain (elem, integ.pnt.,pe)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 xstate(1,j,nelem)
               enddo
            enddo
         endif
!
         if(noelplab(7).eq.'ENER') then
            write(5,*)
            write(5,*) 
     &         'energy density (elem, integ.pnt.,energy)'
            write(5,*)
            do i=1,neprint
               nelem=nelemprint(i)
               if(ipkon(nelem).lt.0) cycle
               if(lakon(nelem)(4:5).eq.'8R') then
                  mint3d=1
               elseif((lakon(nelem)(4:4).eq.'8').or.
     &                (lakon(nelem)(4:6).eq.'20R')) then
                  mint3d=8
               elseif(lakon(nelem)(4:4).eq.'2') then
                  mint3d=27
               elseif(lakon(nelem)(4:5).eq.'10') then
                  mint3d=4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  mint3d=1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  mint3d=9
               else
                  mint3d=2
               endif
               do j=1,mint3d
                  write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                 ener(j,nelem)
               enddo
            enddo
         endif
!
         if(noelplab(8).eq.'SDV ') then
            do l=1,(nstate_+5)/6
               lb=(l-1)*6
               write(5,*)
               if(l.eq.(nstate_+5)/6) then
                  write(5,300) (lb+k,k=1,nstate_-lb)
               else
                  write(5,300) (lb+k,k=1,6)
               endif
 300           format('internal state variables (elem, integ.pnt.)',
     &             6(i2))
               write(5,*)
               do i=1,neprint
                  nelem=nelemprint(i)
                  if(ipkon(nelem).lt.0) cycle
                  if(lakon(nelem)(4:5).eq.'8R') then
                     mint3d=1
                  elseif((lakon(nelem)(4:4).eq.'8').or.
     &                    (lakon(nelem)(4:6).eq.'20R')) then
                     mint3d=8
                  elseif(lakon(nelem)(4:4).eq.'2') then
                     mint3d=27
                  elseif(lakon(nelem)(4:5).eq.'10') then
                     mint3d=4
                  elseif(lakon(nelem)(4:4).eq.'4') then
                     mint3d=1
                  elseif(lakon(nelem)(4:5).eq.'15') then
                     mint3d=9
                  else
                     mint3d=2
                  endif
                  do j=1,mint3d
                     if(l.eq.(nstate_+5)/6) then
                        write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                       (xstate(lb+k,j,nelem),k=1,nstate_-lb)
                     else
                        write(5,'(2i5,1p,6(1x,e11.4))') nelem,j,
     &                       (xstate(lb+k,j,nelem),k=1,6)
                     endif
                  enddo
               enddo
            enddo
         endif
!
      endif
!
!     determining the stresses in the nodes for output in frd format
!
      if(nodeflab(3).eq.'S   ') then
         nfield=6
         ndim=6
         call extrapolate(stx,stn,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the strains in the nodes for output in frd format
!
      if(nodeflab(4).eq.'E   ') then
         nfield=6
         ndim=6
         call extrapolate(eei,een,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the plastic equivalent strain in the nodes 
!     for output in frd format
!
      if(nodeflab(6).eq.'PE  ') then
         nfield=1
         ndim=nstate_
         call extrapolate(xstate,epn,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the total energy in the nodes 
!     for output in frd format
!
      if(nodeflab(7).eq.'ENER') then
         nfield=1
         ndim=1
         call extrapolate(ener,enern,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     determining the internal state variables in the nodes 
!     for output in frd format
!
      if(nodeflab(8).eq.'SDV ') then
         nfield=nstate_
         ndim=nstate_
         call extrapolate(xstate,xstaten,ipkon,inum,kon,lakon,nfield,nk,
     &        ne,mint_,ndim)
      endif
!
!     if neither stresses nor strains are requested: calculate
!     inum: used in subroutine frd to determine which nodes are
!     active in the model (there is always frd output, e.g. U or
!     NT; default is U and S)
!
      if((nodeflab(3).ne.'S   ').and.(nodeflab(4).ne.'E   ').and.
     &   (nodeflab(6).ne.'PE  ').and.(nodeflab(7).ne.'ENER').and.
     &   (nodeflab(8).ne.'SDV ')) then
!
         do i=1,nk
            inum(i)=0
         enddo
!
         do i=1,ne
!
            if(ipkon(i).lt.0) cycle
            indexe=ipkon(i)
            if(lakon(i)(1:4).eq.'C3D1') then
               nopev=4
            else
               nopev=8
            endif
!
            do j=1,nopev
               inum(kon(indexe+j))=inum(kon(indexe+j))+1
            enddo
         enddo
!
!        determining the midside nodes
!
         do i=1,ne
!
            if(ipkon(i).lt.0) cycle
            indexe=ipkon(i)
            if(lakon(i)(4:4).eq.'2') then
               nope=20
               nopev=8
            elseif(lakon(i)(4:4).eq.'8') then
               nope=8
               nopev=8
            elseif(lakon(i)(4:5).eq.'10') then
               nope=10
               nopev=4
            elseif(lakon(i)(4:4).eq.'4') then
               nope=4
               nopev=4
            elseif(lakon(i)(4:5).eq.'15') then
               nope=15
               nopev=6
            else
               nope=6
               nopev=6
            endif
!
            do j=nopev,nope
               if(inum(kon(indexe+j)).eq.0) inum(kon(indexe+j))=-1
            enddo
         enddo
      endif
!
      return
      end

invivoresults_results__1256

Real time: 2.137528e+06 -- Predicted time: 1.115480e+05

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	1.115480e+05	2.149184e+06	94.8

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_InpMtx_src_InpMtx_fullAdj_InpMtx_fullAdjacency_106

Real time: 3.439360e+06 -- Predicted time: 3.657180e+06

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	3.657180e+06	3.479040e+06	4.8

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_newsort_IVDVqsortUp_1253

Real time: 1.646192e+06 -- Predicted time: 3.200466e+06

Callcount: 4949

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
422	### 1	1250.76158940397	9.840000e+02	6.040000e+02	38.6
106	### 2	3915.9375	5.030000e+02	2.560000e+02	49.1

                !
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine mafillsm(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
     &  xboun,nboun,
     &  ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
     &  nforc,nelemload,sideload,xload,nload,p1,p2,om,bodyf,
     &  ad,au,b,bb,nactdof,icol,jq,irow,neq,nzl,nmethod,
     &  ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,
     &  nrhcon,alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
     &  t0,t1,ithermal,prestr,
     &  iprestr,vold,iperturb,sti,nzs,stx,adb,aub,eei,iexpl,plicon,
     &  nplicon,plkcon,nplkcon,xstiff,npmat_,dtime,
     &  matname,mint_,ncmat_,mass,stiffness,buckling,rhs,intscheme,
     &  physcon,shcon,nshcon,cocon,ncocon)
!
!     filling the stiffness matrix in spare matrix format (sm)
!
!     b and f contain the mechanical forces including the thermal
!       contributions (and eigenstress) and those due to nonzero SPC's
!     bb and ff contain the mechanical forces only; bb and ff are used
!       in nonlinear calculations only (iperturb.ge.2)
!
      implicit none
!
      logical mass,stiffness,buckling,rhs,stiffonly
!
      character*8 lakon(*)
      character*20 matname(*)
!
      integer kon(*),nodeboun(*),ndirboun(*),ipompc(*),nodempc(3,*),
     &  nodeforc(*),ndirforc(*),nelemload(2,*),icol(*),jq(*),ikmpc(*),
     &  ilmpc(*),ikboun(*),ilboun(*),nactdof(0:3,*),konl(20),irow(*),
     &  nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(*),ielorien(*),
     &  ipkon(*),intscheme,ncocon(2,*),nshcon(*)
!
      integer nk,ne,nboun,nmpc,nforc,nload,neq,nzl,nmethod,
     &  ithermal,iprestr,iperturb,nzs,i,j,k,l,m,ibod,idist,jj,
     &  ll,id,id1,id2,ist,ist1,ist2,index,jdof1,jdof2,idof1,idof2,idof3,
     &  mpc1,mpc2,index1,index2,jdof,node1,node2,kflag,
     &  ntmat_,indexe,nope,norien,iexpl,mint_,i0,ncmat_
!
      integer nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
      real*8 co(3,*),xboun(*),coefmpc(*),xforc(*),xload(2,*),p1(3),
     &  p2(3),ad(*),au(*),b(*),bodyf(3),bb(*),
     &  t0(*),t1(*),prestr(6,*),vold(0:3,*),s(60,60),f(60),ff(60),
     &  sti(6,mint_,*),sm(60,60),stx(6,mint_,*),adb(*),aub(*),
     &  elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),
     &  alcon(0:6,ntmat_,*),physcon(2),cocon(0:6,ntmat_,*),
     &  shcon(0:1,ntmat_,*),alzero(*),orab(7,*),eei(6,mint_,*)
!
      real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
     &  xstiff(21,mint_,*)
!
      real*8 om,dd,valu2,value,dtime
!
      character*5 sideload(*)
!
      kflag=2
      i0=0
      if(stiffness.and.(.not.mass).and.(.not.buckling)) then
         stiffonly=.true.
      else
         stiffonly=.false.
      endif
!
!     determining nzl and nzs
!
      do i=neq,1,-1
         if(icol(i).gt.0) then
            nzl=i
            exit
         endif
      enddo
!
!     initializing the matrices
!
      if(.not.buckling) then
         do i=1,neq
            ad(i)=0.d0
         enddo
         do i=1,nzs
            au(i)=0.d0
         enddo
      endif
!
      if(rhs) then
         do i=1,neq
            b(i)=0.d0
            bb(i)=0.d0
         enddo
      elseif(mass.or.buckling) then
         do i=1,neq
            adb(i)=0.d0
         enddo
         do i=1,nzs
            aub(i)=0.d0
         enddo
      endif
!
      if(rhs) then
!
!        check for the presence of body forces
!
         dd=dsqrt(bodyf(1)**2+bodyf(2)**2+bodyf(3)**2)
         if((dd.lt.1.d-20).and.(om.lt.1.d-20)) then
            ibod=0
         else
            ibod=1
         endif
!
!        distributed forces (body forces or thermal loads or
!        residual stresses or distributed face loads)
!
         if((ibod.ne.0).or.(ithermal.ne.0).or.
     &      (iprestr.ne.0).or.(nload.ne.0)) then
            idist=1
         else
            idist=0
         endif
!
      endif
!
      if((ithermal.le.1).or.(ithermal.eq.3)) then
!
!     mechanical analysis: loop over all elements
!
      do i=1,ne
!
        if(ipkon(i).lt.0) cycle
        indexe=ipkon(i)
        if(lakon(i)(4:4).eq.'2') then
           nope=20
        elseif(lakon(i)(4:4).eq.'8') then
           nope=8
        elseif(lakon(i)(4:5).eq.'10') then
           nope=10
        elseif(lakon(i)(4:4).eq.'4') then
           nope=4
        elseif(lakon(i)(4:5).eq.'15') then
           nope=15
        else
           nope=6
        endif
!
        do j=1,nope
          konl(j)=kon(indexe+j) 
        enddo
!
        call e_c3d(co,nk,konl,lakon(i),p1,p2,om,bodyf,ibod,s,sm,f,ff,i,
     &          nmethod,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
     &          alzero,ielmat,ielorien,norien,orab,ntmat_,
     &          t0,t1,ithermal,prestr,iprestr,vold,iperturb,
     &          nelemload,sideload,xload,nload,idist,sti,stx,
     &          eei,iexpl,plicon,
     &          nplicon,plkcon,nplkcon,xstiff,npmat_,
     &          dtime,matname,mint_,ncmat_,mass,stiffness,buckling,rhs,
     &          intscheme)
!
        do jj=1,3*nope
!
          j=(jj-1)/3+1
          k=jj-3*(j-1)
!
          node1=kon(indexe+j)
          jdof1=nactdof(k,node1)
!
          do ll=jj,3*nope
!
            l=(ll-1)/3+1
            m=ll-3*(l-1)
!
            node2=kon(indexe+l)
            jdof2=nactdof(m,node2)
!
!           check whether one of the DOF belongs to a SPC or MPC
!
            if((jdof1.ne.0).and.(jdof2.ne.0)) then
               if(stiffonly) then
                  call add_sm_st(au,ad,jq,irow,jdof1,jdof2,
     &                 s(jj,ll),jj,ll)
               else
                  call add_sm_ei(au,ad,aub,adb,jq,irow,jdof1,jdof2,
     &                 s(jj,ll),sm(jj,ll),jj,ll)
               endif
            elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
               if(jdof1.eq.0) then
                  idof1=jdof2
                  idof2=(node1-1)*7+k
               else
                  idof1=jdof1
                  idof2=(node2-1)*7+m
               endif
               if(nmpc.gt.0) then
                  call nident(ikmpc,idof2,nmpc,id)
                  if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                     id=ilmpc(id)
                     ist=ipompc(id)
                     index=nodempc(3,ist)
                     if(index.eq.0) cycle
                     do
                        idof2=nactdof(nodempc(2,index),nodempc(1,index))
                        value=-coefmpc(index)*s(jj,ll)/coefmpc(ist)
                        if(idof1.eq.idof2) value=2.d0*value
                        if(idof2.ne.0) then
                           if(stiffonly) then
                              call add_sm_st(au,ad,jq,irow,idof1,
     &                             idof2,value,i0,i0)
                           else
                              valu2=-coefmpc(index)*sm(jj,ll)/
     &                               coefmpc(ist)
c
                        if(idof1.eq.idof2) valu2=2.d0*valu2
c
                              call add_sm_ei(au,ad,aub,adb,jq,irow,
     &                             idof1,idof2,value,valu2,i0,i0)
                           endif
                        elseif(rhs) then
                           idof2=7*(nodempc(1,index)-1)+nodempc(2,index)
                           call nident(ikboun,idof2,nboun,id)
                           b(idof1)=b(idof1)-xboun(ilboun(id))*value
                        endif
                        index=nodempc(3,index)
                        if(index.eq.0) exit
                     enddo
                     cycle
                  endif
               endif
!
!              regular DOF / SPC
!
               if(rhs) then
                  call nident(ikboun,idof2,nboun,id)
                  b(idof1)=b(idof1)-xboun(ilboun(id))*s(jj,ll)
               endif
            else
               idof1=(node1-1)*7+k
               idof2=(node2-1)*7+m
               mpc1=0
               mpc2=0
               if(nmpc.gt.0) then
                  call nident(ikmpc,idof1,nmpc,id1)
                  if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                  call nident(ikmpc,idof2,nmpc,id2)
                  if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
               endif
               if((mpc1.eq.1).and.(mpc2.eq.1)) then
                  id1=ilmpc(id1)
                  id2=ilmpc(id2)
                  if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                     ist=ipompc(id1)
                     index1=nodempc(3,ist)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        index2=index1
                        do
                           idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                           value=coefmpc(index1)*coefmpc(index2)*
     &                          s(jj,ll)/coefmpc(ist)/coefmpc(ist)
                           if((idof1.ne.0).and.(idof2.ne.0)) then
                              if(stiffonly) then
                                 call add_sm_st(au,ad,jq,irow,
     &                             idof1,idof2,value,i0,i0)
                              else
                                 valu2=coefmpc(index1)*coefmpc(index2)*
     &                             sm(jj,ll)/coefmpc(ist)/coefmpc(ist)
                                 call add_sm_ei(au,ad,aub,adb,jq,
     &                             irow,idof1,idof2,value,valu2,i0,i0)
                              endif
                           elseif((rhs).and.
     &                       ((idof1.ne.0).or.(idof2.ne.0))) then
                              if(idof2.ne.0) then
                                 idof3=idof2
                                 idof2=7*(nodempc(1,index1)-1)+
     &                                 nodempc(2,index1)
                              else
                                 idof3=idof1
                                 idof2=7*(nodempc(1,index2)-1)+
     &                                 nodempc(2,index2)
                              endif
                              call nident(ikboun,idof2,nboun,id)
                              b(idof3)=b(idof3)-value*xboun(ilboun(id))
                           endif
!
                           index2=nodempc(3,index2)
                           if(index2.eq.0) exit
                        enddo
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                   else
!
!                    MPC id1 / MPC id2
!
                     ist1=ipompc(id1)
                     index1=nodempc(3,ist1)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        ist2=ipompc(id2)
                        index2=nodempc(3,ist2)
                        if(index2.eq.0) then
                           index1=nodempc(3,index1)
                           if(index1.eq.0) then
                              exit
                           else
                              cycle
                           endif
                        endif
                        do
                           idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                           value=coefmpc(index1)*coefmpc(index2)*
     &                          s(jj,ll)/coefmpc(ist1)/coefmpc(ist2)
                           if(idof1.eq.idof2) value=2.d0*value
                           if((idof1.ne.0).and.(idof2.ne.0)) then
                              if(stiffonly) then
                                 call add_sm_st(au,ad,jq,irow,
     &                             idof1,idof2,value,i0,i0)
                              else
                                 valu2=coefmpc(index1)*coefmpc(index2)*
     &                             sm(jj,ll)/coefmpc(ist1)/coefmpc(ist2)
c
                        if(idof1.eq.idof2) valu2=2.d0*valu2
c
                                 call add_sm_ei(au,ad,aub,adb,jq,
     &                             irow,idof1,idof2,value,valu2,i0,i0)
                              endif
                           elseif(rhs.and.
     &                       ((idof1.ne.0).or.(idof2.ne.0))) then
                              if(idof2.ne.0) then
                                 idof3=idof2
                                 idof2=7*(nodempc(1,index1)-1)+
     &                                 nodempc(2,index1)
                              else
                                 idof3=idof1
                                 idof2=7*(nodempc(1,index2)-1)+
     &                                 nodempc(2,index2)
                              endif
                              call nident(ikboun,idof2,nboun,id)
                              b(idof3)=b(idof3)-value*xboun(ilboun(id))
                           endif
!
                           index2=nodempc(3,index2)
                           if(index2.eq.0) exit
                        enddo
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                  endif
               elseif(((mpc1.eq.1).or.(mpc2.eq.1)).and.rhs)
     &           then
                  if(mpc1.eq.1) then
!
!                    MPC id1 / SPC
!
                     call nident(ikboun,idof2,nboun,id2)
                     idof2=ilboun(id2)
                     ist1=ipompc(id1)
                     index1=nodempc(3,ist1)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        if(idof1.ne.0) then
                           b(idof1)=b(idof1)+xboun(idof2)*
     &                          coefmpc(index1)*s(jj,ll)/coefmpc(ist1)
                        endif
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                  elseif(mpc2.eq.1) then
!
!                    MPC id2 / SPC
!
                     call nident(ikboun,idof1,nboun,id1)
                     idof1=ilboun(id1)
                     ist2=ipompc(id2)
                     index2=nodempc(3,ist2)
                     if(index2.eq.0) cycle
                     do
                        idof2=nactdof(nodempc(2,index2),
     &                                nodempc(1,index2))
                        if(idof2.ne.0) then
                           b(idof2)=b(idof2)+xboun(idof1)*
     &                          coefmpc(index2)*s(jj,ll)/coefmpc(ist2)
                        endif
                        index2=nodempc(3,index2)
                        if(index2.eq.0) exit
                     enddo
                  endif
               endif
            endif
          enddo
!
          if(rhs) then
!
!            distributed forces
!
             if(idist.ne.0) then
                if(jdof1.eq.0) then
                   if(nmpc.ne.0) then
                      idof1=(node1-1)*7+k
                      call nident(ikmpc,idof1,nmpc,id)
                      if((id.gt.0).and.(ikmpc(id).eq.idof1)) then
                         id=ilmpc(id)
                         ist=ipompc(id)
                         index=nodempc(3,ist)
                         if(index.eq.0) cycle
                         do
                            jdof1=nactdof(nodempc(2,index),
     &                           nodempc(1,index))
                            if(jdof1.ne.0) then
                               b(jdof1)=b(jdof1)-coefmpc(index)*f(jj)/
     &                              coefmpc(ist)
                               bb(jdof1)=bb(jdof1)-coefmpc(index)*ff(jj)
     &                              /coefmpc(ist)
                            endif
                            index=nodempc(3,index)
                            if(index.eq.0) exit
                         enddo
                      endif
                   endif
                   cycle
                endif
                b(jdof1)=b(jdof1)+f(jj)
                bb(jdof1)=bb(jdof1)+ff(jj)
             endif
          endif
!
        enddo
      enddo
!
      else
!
!     thermal analysis: loop over all elements
!
      do i=1,ne
!
        if(ipkon(i).lt.0) cycle
        indexe=ipkon(i)
        if(lakon(i)(4:4).eq.'2') then
           nope=20
        elseif(lakon(i)(4:4).eq.'8') then
           nope=8
        elseif(lakon(i)(4:5).eq.'10') then
           nope=10
        elseif(lakon(i)(4:4).eq.'4') then
           nope=4
        elseif(lakon(i)(4:5).eq.'15') then
           nope=15
        else
           nope=6
        endif
!
        do j=1,nope
          konl(j)=kon(indexe+j) 
        enddo
!
        call e_c3d_th(co,nk,konl,lakon(i),p1,p2,om,bodyf,ibod,s,sm,f,ff,
     &          i,nmethod,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
     &          alzero,ielmat,ielorien,norien,orab,ntmat_,
     &          t0,t1,ithermal,prestr,iprestr,vold,iperturb,
     &          nelemload,sideload,xload,nload,idist,sti,stx,
     &          eei,iexpl,plicon,
     &          nplicon,plkcon,nplkcon,xstiff,npmat_,
     &          dtime,matname,mint_,ncmat_,mass,stiffness,buckling,rhs,
     &          intscheme,physcon,shcon,nshcon,cocon,ncocon)
!
        do jj=1,nope
!
          j=jj
c          k=0
!
          node1=kon(indexe+j)
          jdof1=nactdof(0,node1)
!
          do ll=jj,nope
!
            l=ll
c            m=0
!
            node2=kon(indexe+l)
            jdof2=nactdof(0,node2)
!
!           check whether one of the DOF belongs to a SPC or MPC
!
            if((jdof1.ne.0).and.(jdof2.ne.0)) then
               if(stiffonly) then
                  call add_sm_st(au,ad,jq,irow,jdof1,jdof2,
     &                 s(jj,ll),jj,ll)
               else
                  call add_sm_ei(au,ad,aub,adb,jq,irow,jdof1,jdof2,
     &                 s(jj,ll),sm(jj,ll),jj,ll)
               endif
            elseif((jdof1.ne.0).or.(jdof2.ne.0)) then
!
!              idof1: genuine DOF
!              idof2: nominal DOF of the SPC/MPC
!
               if(jdof1.eq.0) then
                  idof1=jdof2
                  idof2=(node1-1)*7
               else
                  idof1=jdof1
                  idof2=(node2-1)*7
               endif
               if(nmpc.gt.0) then
                  call nident(ikmpc,idof2,nmpc,id)
                  if((id.gt.0).and.(ikmpc(id).eq.idof2)) then
!
!                    regular DOF / MPC
!
                     id=ilmpc(id)
                     ist=ipompc(id)
                     index=nodempc(3,ist)
                     if(index.eq.0) cycle
                     do
                        idof2=nactdof(nodempc(2,index),nodempc(1,index))
                        value=-coefmpc(index)*s(jj,ll)/coefmpc(ist)
                        if(idof1.eq.idof2) value=2.d0*value
                        if(idof2.ne.0) then
                           if(stiffonly) then
                              call add_sm_st(au,ad,jq,irow,idof1,
     &                             idof2,value,i0,i0)
                           else
                              valu2=-coefmpc(index)*sm(jj,ll)/
     &                               coefmpc(ist)
c
                        if(idof1.eq.idof2) valu2=2.d0*valu2
c
                              call add_sm_ei(au,ad,aub,adb,jq,irow,
     &                             idof1,idof2,value,valu2,i0,i0)
                           endif
                        elseif(rhs) then
                           idof2=7*(nodempc(1,index)-1)+nodempc(2,index)
                           call nident(ikboun,idof2,nboun,id)
                           b(idof1)=b(idof1)-xboun(ilboun(id))*value
                        endif
                        index=nodempc(3,index)
                        if(index.eq.0) exit
                     enddo
                     cycle
                  endif
               endif
!
!              regular DOF / SPC
!
               if(rhs) then
                  call nident(ikboun,idof2,nboun,id)
                  b(idof1)=b(idof1)-xboun(ilboun(id))*s(jj,ll)
               endif
            else
               idof1=(node1-1)*7
               idof2=(node2-1)*7
               mpc1=0
               mpc2=0
               if(nmpc.gt.0) then
                  call nident(ikmpc,idof1,nmpc,id1)
                  if((id1.gt.0).and.(ikmpc(id1).eq.idof1)) mpc1=1
                  call nident(ikmpc,idof2,nmpc,id2)
                  if((id2.gt.0).and.(ikmpc(id2).eq.idof2)) mpc2=1
               endif
               if((mpc1.eq.1).and.(mpc2.eq.1)) then
                  id1=ilmpc(id1)
                  id2=ilmpc(id2)
                  if(id1.eq.id2) then
!
!                    MPC id1 / MPC id1
!
                     ist=ipompc(id1)
                     index1=nodempc(3,ist)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        index2=index1
                        do
                           idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                           value=coefmpc(index1)*coefmpc(index2)*
     &                          s(jj,ll)/coefmpc(ist)/coefmpc(ist)
                           if((idof1.ne.0).and.(idof2.ne.0)) then
                              if(stiffonly) then
                                 call add_sm_st(au,ad,jq,irow,
     &                             idof1,idof2,value,i0,i0)
                              else
                                 valu2=coefmpc(index1)*coefmpc(index2)*
     &                             sm(jj,ll)/coefmpc(ist)/coefmpc(ist)
                                 call add_sm_ei(au,ad,aub,adb,jq,
     &                             irow,idof1,idof2,value,valu2,i0,i0)
                              endif
                           elseif((rhs).and.
     &                       ((idof1.ne.0).or.(idof2.ne.0))) then
                              if(idof2.ne.0) then
                                 idof3=idof2
                                 idof2=7*(nodempc(1,index1)-1)+
     &                                 nodempc(2,index1)
                              else
                                 idof3=idof1
                                 idof2=7*(nodempc(1,index2)-1)+
     &                                 nodempc(2,index2)
                              endif
                              call nident(ikboun,idof2,nboun,id)
                              b(idof3)=b(idof3)-value*xboun(ilboun(id))
                           endif
!
                           index2=nodempc(3,index2)
                           if(index2.eq.0) exit
                        enddo
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                   else
!
!                    MPC id1 / MPC id2
!
                     ist1=ipompc(id1)
                     index1=nodempc(3,ist1)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        ist2=ipompc(id2)
                        index2=nodempc(3,ist2)
                        if(index2.eq.0) then
                           index1=nodempc(3,index1)
                           if(index1.eq.0) then
                              exit
                           else
                              cycle
                           endif
                        endif
                        do
                           idof2=nactdof(nodempc(2,index2),
     &                                   nodempc(1,index2))
                           value=coefmpc(index1)*coefmpc(index2)*
     &                          s(jj,ll)/coefmpc(ist1)/coefmpc(ist2)
                           if(idof1.eq.idof2) value=2.d0*value
                           if((idof1.ne.0).and.(idof2.ne.0)) then
                              if(stiffonly) then
                                 call add_sm_st(au,ad,jq,irow,
     &                             idof1,idof2,value,i0,i0)
                              else
                                 valu2=coefmpc(index1)*coefmpc(index2)*
     &                             sm(jj,ll)/coefmpc(ist1)/coefmpc(ist2)
c
                        if(idof1.eq.idof2) valu2=2.d0*valu2
c
                                 call add_sm_ei(au,ad,aub,adb,jq,
     &                             irow,idof1,idof2,value,valu2,i0,i0)
                              endif
                           elseif(rhs.and.
     &                       ((idof1.ne.0).or.(idof2.ne.0))) then
                              if(idof2.ne.0) then
                                 idof3=idof2
                                 idof2=7*(nodempc(1,index1)-1)+
     &                                 nodempc(2,index1)
                              else
                                 idof3=idof1
                                 idof2=7*(nodempc(1,index2)-1)+
     &                                 nodempc(2,index2)
                              endif
                              call nident(ikboun,idof2,nboun,id)
                              b(idof3)=b(idof3)-value*xboun(ilboun(id))
                           endif
!
                           index2=nodempc(3,index2)
                           if(index2.eq.0) exit
                        enddo
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                  endif
               elseif(((mpc1.eq.1).or.(mpc2.eq.1)).and.rhs)
     &           then
                  if(mpc1.eq.1) then
!
!                    MPC id1 / SPC
!
                     call nident(ikboun,idof2,nboun,id2)
                     idof2=ilboun(id2)
                     ist1=ipompc(id1)
                     index1=nodempc(3,ist1)
                     if(index1.eq.0) cycle
                     do
                        idof1=nactdof(nodempc(2,index1),
     &                                nodempc(1,index1))
                        if(idof1.ne.0) then
                           b(idof1)=b(idof1)+xboun(idof2)*
     &                          coefmpc(index1)*s(jj,ll)/coefmpc(ist1)
                        endif
                        index1=nodempc(3,index1)
                        if(index1.eq.0) exit
                     enddo
                  elseif(mpc2.eq.1) then
!
!                    MPC id2 / SPC
!
                     call nident(ikboun,idof1,nboun,id1)
                     idof1=ilboun(id1)
                     ist2=ipompc(id2)
                     index2=nodempc(3,ist2)
                     if(index2.eq.0) cycle
                     do
                        idof2=nactdof(nodempc(2,index2),
     &                                nodempc(1,index2))
                        if(idof2.ne.0) then
                           b(idof2)=b(idof2)+xboun(idof1)*
     &                          coefmpc(index2)*s(jj,ll)/coefmpc(ist2)
                        endif
                        index2=nodempc(3,index2)
                        if(index2.eq.0) exit
                     enddo
                  endif
               endif
            endif
          enddo
!
          if(rhs) then
!
!            distributed forces
!
             if(idist.ne.0) then
                if(jdof1.eq.0) then
                   if(nmpc.ne.0) then
                      idof1=(node1-1)*7
                      call nident(ikmpc,idof1,nmpc,id)
                      if((id.gt.0).and.(ikmpc(id).eq.idof1)) then
                         id=ilmpc(id)
                         ist=ipompc(id)
                         index=nodempc(3,ist)
                         if(index.eq.0) cycle
                         do
                            jdof1=nactdof(nodempc(2,index),
     &                           nodempc(1,index))
                            if(jdof1.ne.0) then
                               b(jdof1)=b(jdof1)-coefmpc(index)*f(jj)/
     &                              coefmpc(ist)
                               bb(jdof1)=bb(jdof1)-coefmpc(index)*ff(jj)
     &                              /coefmpc(ist)
                            endif
                            index=nodempc(3,index)
                            if(index.eq.0) exit
                         enddo
                      endif
                   endif
                   cycle
                endif
                b(jdof1)=b(jdof1)+f(jj)
                bb(jdof1)=bb(jdof1)+ff(jj)
             endif
          endif
!
        enddo
      enddo
!
      endif
!
      if(rhs) then
!
!        point forces
!      
         do i=1,nforc
            jdof=nactdof(ndirforc(i),nodeforc(i))
            if(jdof.ne.0) then
               b(jdof)=b(jdof)+xforc(i)
               bb(jdof)=bb(jdof)+xforc(i)
            endif
         enddo
!
      endif
!
c      write(*,'(6(1x,e11.4))') (au(i),i=1,nzs)
c      write(*,'(6(1x,e11.4))') (ad(i),i=1,neq)
c      write(*,'(6(1x,e11.4))') (b(i),i=1,neq)
c      write(*,'(6(1x,e11.4))') (bb(i),i=1,neq)
!
      return
      end

invivomafillsm_mafillsm__146

Real time: 1.097620e+07 -- Predicted time: 1.111723e+07

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	1.111723e+07	1.097938e+07	1.2

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_FrontMtx_src_FrontMtx_update_FrontMtx_update_37

Real time: 5.072364e+06 -- Predicted time: 7.213491e+05

Callcount: 13

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
2	### 1	11.4839687494362	0.000000e+00	2.216920e+05	100.0
6	### 2	3.01311624556948	2.394030e+05	8.441440e+05	71.6

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_DV_DVaxpy_59

Real time: 2.115172e+06 -- Predicted time: 4.977536e+06

Callcount: 14445

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1808	### 1	615.566666666667	3.170000e+02	2.400000e+02	24.2
1076	### 2	1870.32608695652	4.290000e+02	1.840000e+02	57.1
3	### 3	2666.05882352941	3.800000e+02	1.360000e+02	64.2
16	### 4	1859.29268292683	2.440000e+02	1.640000e+02	32.7
11	### 5	2564.02702702703	3.060000e+02	1.480000e+02	51.6
34	### 6	1377.13333333333	5.350000e+02	1.200000e+02	77.5
58	### 7	1402.18518518519	3.240000e+02	1.080000e+02	66.6
94	### 8	785.884615384615	2.900000e+02	2.080000e+02	28.2
13030	### 9	1352.35294117647	2.290000e+02	6.800000e+01	70.3

                /*     CalculiX - A 3-dimensional finite element program                 */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                                                                       */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdlib.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "CalculiX.h"

int main(int argc,char *argv[])
{
  int *kon=NULL, *nodeboun=NULL, *ndirboun=NULL, *ipompc=NULL,
    *nodempc=NULL, *nodeforc=NULL, *ndirforc=NULL,
    *nelemload=NULL, *nodeprint=NULL, *nelemprint=NULL,
    *nnn=NULL, *nactdof=NULL, *icol=NULL,*ics=NULL,
    *jq=NULL, *mast1=NULL, *irow=NULL, *rig=NULL,
    *ikmpc=NULL, *ilmpc=NULL, *ikboun=NULL, *ilboun=NULL,
    *npn=NULL, *adj=NULL, *xadj=NULL, *iw=NULL, *nreorder=NULL,
    *mmm=NULL, *xnpn=NULL, *ikcol=NULL, *ipointer=NULL,
    *istartset=NULL, *iendset=NULL, *ialset=NULL, *ielmat=NULL,
    *ielorien=NULL, *nrhcon=NULL, *nodebounold=NULL, *ndirbounold=NULL,
    *nelcon=NULL, *nalcon=NULL, *iamforc=NULL,  *iamload=NULL,
    *iamt1=NULL, *namta=NULL, *ipkon=NULL, *iamboun=NULL,
    *nplicon=NULL, *nplkcon=NULL, *inotr=NULL, *iponor=NULL, *knor=NULL,
    *ikforc=NULL, *ilforc=NULL, *iponoel=NULL, *inoel=NULL, *nshcon=NULL,
    *ncocon=NULL,  *nodeflow=NULL,*iamflow=NULL;

double *co=NULL, *xboun=NULL, *coefmpc=NULL, *xforc=NULL,
      *xload=NULL, *ad=NULL, *au=NULL, *xbounold=NULL, *xforcold=NULL,
      *b=NULL, *vold=NULL, *sti=NULL, *xloadold=NULL, *xnor=NULL,
      *reorder=NULL,*dcs=NULL, *thickn=NULL, *thicke=NULL, *offset=NULL,
      *elcon=NULL, *rhcon=NULL, *alcon=NULL, *alzero=NULL, *t0=NULL, *t1=NULL,
      *prestr=NULL, *orab=NULL, *amta=NULL, *veold=NULL, *accold=NULL,
      *adb=NULL, *aub=NULL, *t1old=NULL, *eei=NULL, *plicon=NULL, *plkcon=NULL,
      *xstate=NULL, *trab=NULL, *ener=NULL, *shcon=NULL, *cocon=NULL,
      *xflow=NULL,*xflowold=NULL;

 double ctrl[26]={4.5,8.5,9.5,16.5,10.5,4.5,0.,5.5,0.,0.,0.25,0.5,0.75,0.,0.,0.,1.5,0.,0.005,0.01,0.,0.,0.02,1.e-5,1.e-3,1.e-8};

char *sideload=NULL, *set=NULL, *matname=NULL, *orname=NULL, *amname=NULL,
      *noelplab=NULL, *nodeflab=NULL, *lakon=NULL, *labmpc=NULL, 
      jobnamec[132]="",jobnamef[132]="",output[3]="frd";

int sideloadLen=5, setLen=21, matnameLen=20, ornameLen=20, amnameLen=20, noelplabLen=4, 
    nodeflabLen=4, lakonLen=8, labmpcLen=20, jobnamecLen=132, jobnamefLen=132, outputLen=3;

int nk,ne,nboun,nmpc,nforc,nload,noprint,neprint,nset,nalset,nsky,
  nmethod,neq=0,i,mpcfree=1,nev,j,nzl,nam,nbounold=0,nforcold=0,nloadold=0,
  k,nzs,nmpc_=0,nload_=0,nforc_=0,istep,istat,nboun_=0,nflowold=0,
  iperturb=0,nmat,ntmat_=0,norien,ithermal,iprestr,in,kode,isolver=0,
  mxiter,ncv,iamom,iambodyf,jout,nlabel,nkon=0,idrct,jmax,iexpl,
  iplas=0,npmat_=0,mint_=0,ntrans,mpcend,namtot_=0,ns[5],iumat=0,mpcmult,
  icascade,maxlenmpc,mpcinfo[4],ne1d=0,ne2d=0,infree[4]={0,0,0,0},
  callfrommain,nflow,nflow_=0,jin=0;

int itread,*meminset=NULL,*rmeminset=NULL;

int nzs_,nk_=0,ne_=0,nset_=0,nalset_=0,nmat_=0,norien_=0,nam_=0,noprint_=0,
    neprint_=0,ntrans_=0,ncs_=0,nstate_=0,ncmat_=0,memmpc_=0;

double p1[3],p2[3],bodyf[3],om,omold,tol,bodyfold[3],
  tinc,tper,tmin,tmax,alpham=0.,betam=0.,alpha,haftol,ttime=0.,
  qaold=0.,csab[7],physcon[2];

#ifdef SPEC_CPU
FILE *fpfor_ztest;
int  intfor_ztest;
#endif

if(argc==1){printf("Usage: CalculiX.exe -i jobname\n");FORTRAN(stop,());}
else{
  for(i=1;i<argc;i++){
    if(strcmp1(argv[i],"-i")==0) {
    strcpy(jobnamec,argv[i+1]);strcpy1(jobnamef,argv[i+1],132);jin++;break;}
  }
  if(jin==0){strcpy(jobnamec,argv[1]);strcpy1(jobnamef,argv[1],132);}

  for(i=1;i<argc;i++){
    if(strcmp1(argv[i],"-o")==0) {
    strcpy(output,argv[i+1]);break;}
  }
}

#ifdef SPEC_CPU
/* Test whether the portability switch -DSPEC_CPU_NOZMODIFIER needs */
/* to be set.  SPEC has modified CalculiX and SPOOLES to use %zd        */
/* when printing pointers; but not all compilers support this.  So, for */
/* those compilers a portability switch is provided.  Find out whether  */
/* that switch should be used today.  --jh 17 Feb 2005                  */

intfor_ztest = 3;
fpfor_ztest = fopen ("SPECtestformatmodifier_z.txt","w");
fprintf (fpfor_ztest, "The following line should contain a single '3':\n");

#ifdef SPEC_CPU_NOZMODIFIER
fprintf (fpfor_ztest, "%d\n", (size_t) intfor_ztest);
#else
fprintf (fpfor_ztest, "%zd\n", (size_t) intfor_ztest);
#endif /* SPEC_CPU_NOZMODIFIER */

fprintf (fpfor_ztest, "If it said anything else (such as 'zd') try compiling\n");
fprintf (fpfor_ztest, "with -DSPEC_CPU_NOZMODIFIER\n");
fclose(fpfor_ztest);
#endif /* SPEC_CPU */ 

#if defined(SPEC_CPU_NAGF95)
FORTRAN(openfile,(jobnamef,output,132,3));
#else
FORTRAN(openfile,(jobnamef,output));
#endif


printf("\n************************************************************\n\n");
printf("CalculiX DEVELOPMENT VERSION, Copyright(C) 1998 Guido Dhondt\n");
printf("CalculiX comes with ABSOLUTELY NO WARRANTY. This is free\n");
printf("software, and you are welcome to redistribute it under\n");
printf("certain conditions, see gpl.htm\n\n");
printf("************************************************************\n\n");

istep=0;
istat=0;
ithermal=0;
iprestr=0;
in=1;
kode=0;
ns[0]=0;
ns[4]=1;

/* conservative estimate of the fields to be allocated */

for(itread=0;itread<2;itread++){

#if defined(SPEC_CPU_NAGF95)
  FORTRAN(allocation,(&nload_,&nforc_,&nboun_,&nk_,&ne_,&nmpc_,&nset_,&nalset_,
   &nmat_,&ntmat_,&npmat_,&norien_,&nam_,&noprint_,&neprint_,&mint_,&ntrans_,
   &in,&itread,set,meminset,rmeminset,&ncs_,&namtot_,&ncmat_,&memmpc_,&ne1d,
   &ne2d,&nflow_, setLen));
#else
  FORTRAN(allocation,(&nload_,&nforc_,&nboun_,&nk_,&ne_,&nmpc_,&nset_,&nalset_,
   &nmat_,&ntmat_,&npmat_,&norien_,&nam_,&noprint_,&neprint_,&mint_,&ntrans_,
   &in,&itread,set,meminset,rmeminset,&ncs_,&namtot_,&ncmat_,&memmpc_,&ne1d,
   &ne2d,&nflow_));
#endif

  if(itread==0){
    setLen = 21*nset_; // added by yusuf
    set=NNEW(char,21*nset_);
    meminset=NNEW(int,nset_);
    rmeminset=NNEW(int,nset_);}
  else{free(set);free(meminset);free(rmeminset);}
}

nzs_=20000000;

nload=0;nforc=0;nboun=0;nk=0;nmpc=0;nflow=0;
nlabel=8;

for(k=0;k<3;++k){
  p1[k]=0.;
  p2[k]=0.;
  bodyf[k]=0.;
}
om=0.;
iamom=0;
iambodyf=0;

while(istat>=0) {

  /* in order to reduce the number of variables to be transferred to
     the subroutines, the max. field sizes are (for most fields) copied
     into the real sizes */

  nzs=nzs_;
  noprint=noprint_;
  neprint=neprint_;

  if(istep == 0) {
    ne=ne_;
    nset=nset_;
    nalset=nalset_;
    nmat=nmat_;
    norien=norien_;
    ntrans=ntrans_;
    nam=nam_;

    /* allocating space before the first step */

    /* coordinates and topology */

    co=NNEW(double,3*nk_);
    kon=NNEW(int,20*ne_);
    ipkon=NNEW(int,ne_);
    lakonLen = 8*ne_; // added by yusuf
    lakon=NNEW(char,8*ne_);

    /* fields for 1-D and 2-D elements */

    if((ne1d!=0)||(ne2d!=0)){
	iponor=NNEW(int,40*ne_);
	for(i=0;i<40*ne_;i++) iponor[i]=-1;
	xnor=NNEW(double,36*ne1d+24*ne2d);
	knor=NNEW(int,24*(ne1d+ne2d));
	thickn=NNEW(double,2*nk_);
	thicke=NNEW(double,40*ne_);
	offset=NNEW(double,2*ne_);
	iponoel=NNEW(int,nk_);
	inoel=NNEW(int,9*ne1d+24*ne2d);
	rig=NNEW(int,nk_);
	infree[2]=1;
    }

    /* SPC's */

    nodeboun=NNEW(int,nboun_);
    ndirboun=NNEW(int,nboun_);
    iamboun=NNEW(int,nboun_);
    xboun=NNEW(double,nboun_);
    ikboun=NNEW(int,nboun_);
    ilboun=NNEW(int,nboun_);

    /* MPC's */

    ipompc=NNEW(int,nmpc_);
    nodempc=NNEW(int,3*memmpc_);
    for(i=0;i<3*memmpc_;i+=3){nodempc[i+2]=i/3+2;}
    nodempc[3*memmpc_-1]=0;
    coefmpc=NNEW(double,memmpc_);
    labmpcLen = 20*nmpc_; // added by yusuf
    labmpc=NNEW(char,20*nmpc_);
    ikmpc=NNEW(int,nmpc_);
    ilmpc=NNEW(int,nmpc_);


    /* nodal loads */

    nodeforc=NNEW(int,nforc_);
    ndirforc=NNEW(int,nforc_);
    iamforc=NNEW(int,nforc_);
    xforc=NNEW(double,nforc_);
    ikforc=NNEW(int,nforc_);
    ilforc=NNEW(int,nforc_);

    /* distributed loads */

    nelemload=NNEW(int,2*nload_);
    iamload=NNEW(int,2*nload_);
    sideloadLen = 5*nload_; // added by yusuf
    sideload=NNEW(char,5*nload_);
    xload=NNEW(double,2*nload_);

    /* mass flow rate */

    nodeflow=NNEW(int,2*nflow_);
    iamflow=NNEW(int,nflow_);
    xflow=NNEW(double,nflow_);

    /* printing output */

    nodeprint=NNEW(int,noprint);
    nelemprint=NNEW(int,neprint);

    /* set definitions */

    setLen = 21*nset; // added by yusuf
    set=NNEW(char,21*nset);
    istartset=NNEW(int,nset);
    iendset=NNEW(int,nset);
    ialset=NNEW(int,nalset);

    /* (hyper)elastic constants */

    elcon=NNEW(double,(ncmat_+1)*ntmat_*nmat);
    nelcon=NNEW(int,2*nmat);

    /* density */

    rhcon=NNEW(double,2*ntmat_*nmat);
    nrhcon=NNEW(int,nmat);

    /* specific heat */

    shcon=NNEW(double,2*ntmat_*nmat);
    nshcon=NNEW(int,nmat);

    /* thermal expansion coefficients */

    alcon=NNEW(double,7*ntmat_*nmat);
    nalcon=NNEW(int,2*nmat);
    alzero=NNEW(double,nmat);

    /* conductivity */

    cocon=NNEW(double,7*ntmat_*nmat);
    ncocon=NNEW(int,2*nmat);

    /* isotropic and kinematic hardening coefficients*/

    plicon=NNEW(double,(2*npmat_+1)*ntmat_*nmat);
    nplicon=NNEW(int,(ntmat_+1)*nmat);
    plkcon=NNEW(double,(2*npmat_+1)*ntmat_*nmat);
    nplkcon=NNEW(int,(ntmat_+1)*nmat);

    /* material orientation */

    ornameLen = 20*norien; // added by yusuf
    orname=NNEW(char,20*norien);
    orab=NNEW(double,7*norien);
    ielorien=NNEW(int,ne_);

    /* transformations */

    trab=NNEW(double,7*ntrans);
    inotr=NNEW(int,2*nk_);

    /* amplitude definitions */

    amnameLen = 20*nam; // added by yusuf
    amname=NNEW(char,20*nam);
    amta=NNEW(double,2*namtot_);
    namta=NNEW(int,3*nam);

    /* temperatures */

    if((ne1d==0)&&(ne2d==0)){
	t0=NNEW(double,nk_);
	t1=NNEW(double,nk_);}
    else{
	t0=NNEW(double,3*nk_);
	t1=NNEW(double,3*nk_);}
    iamt1=NNEW(int,nk_);

    prestr=NNEW(double,6*ne_);
    veold=NNEW(double,4*nk_);

    ielmat=NNEW(int,ne_);

    matnameLen = 20*nmat; // added by yusuf
    matname=NNEW(char,20*nmat);

    noelplabLen = 4*nlabel; // added by yusuf
    noelplab=NNEW(char,4*nlabel);
    nodeflabLen = 4*nlabel; // added by yusuf
    nodeflab=NNEW(char,4*nlabel);

    /* temporary fields for cyclic symmetry calculations */

    if(ncs_>0){
      ics=NNEW(int,3*ncs_);
      dcs=NNEW(double,4*ncs_);
    }

  }
  else {

    /* allocating and reallocating space for subsequent steps */

    if((nmethod != 4) && ((nmethod != 1) || (iperturb < 2))){
      veold=NNEW(double,4*nk_);
    }
    else{
      RENEW(veold,double,4*nk_);
    }

    if(nmethod != 4){free(accold);}

    RENEW(nodeboun,int,nboun_);
    RENEW(ndirboun,int,nboun_);
    RENEW(xboun,double,nboun_);
    RENEW(ikboun,int,nboun_);
    RENEW(ilboun,int,nboun_);

    RENEW(nodeforc,int,nforc_);
    RENEW(ndirforc,int,nforc_);
    RENEW(xforc,double,nforc_);
    RENEW(ikforc,int,nforc_);
    RENEW(ilforc,int,nforc_);

    RENEW(nelemload,int,2*nload_);
    sideloadLen = 5*nload_; // added by yusuf
    RENEW(sideload,char,5*nload_);
    RENEW(xload,double,2*nload_);

    RENEW(nodeflow,int,2*nflow_);
    RENEW(xflow,double,nflow_);

    RENEW(nodeprint,int,noprint);
    RENEW(nelemprint,int,neprint);

    if(nam > 0) {
      RENEW(iamforc,int,nforc_);
      RENEW(iamload,int,2*nload_);
      RENEW(iamboun,int,nboun_);
      RENEW(iamflow,int,nflow_);
    }

    RENEW(ipompc,int,nmpc_);
/*    RENEW(nodempc,int,3*memmpc_);
    for(i=3*mpcend;i<3*memmpc_;i+=3){nodempc[i+2]=i/3+2;}
    nodempc[3*memmpc_-1]=0;
    RENEW(coefmpc,double,memmpc_);*/
    labmpcLen = 20*nmpc_; // added by yusuf
    RENEW(labmpc,char,20*nmpc_);
    RENEW(ikmpc,int,nmpc_);
    RENEW(ilmpc,int,nmpc_);

    if(ntrans > 0){
      RENEW(inotr,int,2*nk_);
    }

    RENEW(co,double,3*nk_);

    if(ithermal != 0){
	if((ne1d==0)&&(ne2d==0)){
	    RENEW(t0,double,nk_);
	    RENEW(t1,double,nk_);
	}
      if(nam > 0) {RENEW(iamt1,int,nk_);}
    }

  }

  /* reading the input file */

#if defined(SPEC_CPU_NAGF95)
  FORTRAN(calinput,(co,&nk,kon,ipkon,lakon,&nkon,&ne,
            nodeboun,ndirboun,xboun,&nboun,
	    ipompc,nodempc,coefmpc,&nmpc,&nmpc_,nodeforc,ndirforc,xforc,&nforc,
	    &nforc_,nelemload,sideload,xload,&nload,&nload_,p1,p2,&om,bodyf,
	    nodeprint,&noprint,nelemprint,&neprint,&mpcfree,&nboun_,
	    &nev,set,istartset,iendset,
	    ialset,&nset,&nalset,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
	    alzero,t0,t1,matname,ielmat,orname,orab,ielorien,amname,
            amta,namta,&nam,&nmethod,iamforc,iamload,&iamom,&iambodyf,iamt1,
	    &ithermal,&iperturb,&istat,&istep,&nmat,&ntmat_,&norien,prestr,
	    &iprestr,&in,&isolver,&tol,&ncv,&mxiter,veold,&tinc,&tper,
	    &alpham,&betam,noelplab,nodeflab,&jout,&nlabel,&idrct,
	    &jmax,&tmin,&tmax,&iexpl,&alpha,&haftol,iamboun,plicon,nplicon,
	    plkcon,nplkcon,&iplas,&npmat_,&mint_,&nk_,trab,inotr,&ntrans,
	    ikboun,ilboun,ikmpc,ilmpc,ics,dcs,&ncs_,&namtot_,ns,&nstate_,
	    &ncmat_,&iumat,csab,labmpc,iponor,xnor,knor,thickn,thicke,
	    ikforc,ilforc,offset,iponoel,inoel,rig,infree,nshcon,shcon,
            cocon,ncocon,physcon,&nflow,nodeflow,xflow,iamflow,&nflow_,
            ctrl, lakonLen, sideloadLen, setLen, matnameLen, ornameLen, 
            amnameLen, noelplabLen, nodeflabLen, labmpcLen));
#else
  FORTRAN(calinput,(co,&nk,kon,ipkon,lakon,&nkon,&ne,
            nodeboun,ndirboun,xboun,&nboun,
	    ipompc,nodempc,coefmpc,&nmpc,&nmpc_,nodeforc,ndirforc,xforc,&nforc,
	    &nforc_,nelemload,sideload,xload,&nload,&nload_,p1,p2,&om,bodyf,
	    nodeprint,&noprint,nelemprint,&neprint,&mpcfree,&nboun_,
	    &nev,set,istartset,iendset,
	    ialset,&nset,&nalset,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
	    alzero,t0,t1,matname,ielmat,orname,orab,ielorien,amname,
            amta,namta,&nam,&nmethod,iamforc,iamload,&iamom,&iambodyf,iamt1,
	    &ithermal,&iperturb,&istat,&istep,&nmat,&ntmat_,&norien,prestr,
	    &iprestr,&in,&isolver,&tol,&ncv,&mxiter,veold,&tinc,&tper,
	    &alpham,&betam,noelplab,nodeflab,&jout,&nlabel,&idrct,
	    &jmax,&tmin,&tmax,&iexpl,&alpha,&haftol,iamboun,plicon,nplicon,
	    plkcon,nplkcon,&iplas,&npmat_,&mint_,&nk_,trab,inotr,&ntrans,
	    ikboun,ilboun,ikmpc,ilmpc,ics,dcs,&ncs_,&namtot_,ns,&nstate_,
	    &ncmat_,&iumat,csab,labmpc,iponor,xnor,knor,thickn,thicke,
	    ikforc,ilforc,offset,iponoel,inoel,rig,infree,nshcon,shcon,
            cocon,ncocon,physcon,&nflow,nodeflow,xflow,iamflow,&nflow_,
            ctrl));
#endif

  if(istep == 1) {

    /* reallocating space in the first step */

    /* allocating and initializing fields pointing to the previous step */

    vold=NNEW(double,4*nk);
    sti=NNEW(double,6*mint_*ne);

    /* residual stresses */

    if(iprestr > 0) {
	RENEW(prestr,double,6*ne);
	for(i=0;i<ne;i++){
	    for(j=0;j<mint_;j++){
		for(k=0;k<6;k++){
		    sti[6*mint_*i+6*j+k]=prestr[6*i+k];
		}
	    }
	}
    }
    else {
	free(prestr);
    }

    if((strcmp1(&nodeflab[24],"ENER")==0)||(strcmp1(&noelplab[24],"ENER")==0))
	ener=NNEW(double,mint_*ne);

    nodebounold=NNEW(int,nboun);
    ndirbounold=NNEW(int,nboun);
    xbounold=NNEW(double,nboun);
    xforcold=NNEW(double,nforc);
    xloadold=NNEW(double,2*nload);
    if(ithermal>1) xflowold=NNEW(double,nflow);
    for(i=0;i<3;i++) bodyfold[i]=0;
    omold=0;
    if(ithermal==1){
      t1old=NNEW(double,nk);
      for(i=0;i<nk;i++) t1old[i]=t0[i];
    }

    /* strains */

    eei=NNEW(double,6*mint_*ne);

    /* element definition */

    RENEW(kon,int,nkon);
    RENEW(ipkon,int,ne);
    lakonLen = 8*ne; // added by yusuf
    RENEW(lakon,char,8*ne);

    /* fields for 1-D and 2-D elements */

    if((ne1d!=0)||(ne2d!=0)){
	RENEW(iponor,int,2*nkon);
	RENEW(xnor,double,infree[0]-1);
	RENEW(knor,int,infree[1]-1);
	free(thickn);
	RENEW(thicke,double,2*nkon);
	RENEW(offset,double,2*ne);
	RENEW(inoel,int,3*(infree[2]-1));
	RENEW(iponoel,int,infree[3]);
	RENEW(rig,int,infree[3]);
    }

    /* set definitions */ 

    setLen = 21*nset; // added by yusuf
    RENEW(set,char,21*nset);
    RENEW(istartset,int,nset);
    RENEW(iendset,int,nset);
    RENEW(ialset,int,nalset);

    /* material properties */

    RENEW(elcon,double,(ncmat_+1)*ntmat_*nmat);
    RENEW(nelcon,int,2*nmat);

    RENEW(rhcon,double,2*ntmat_*nmat);
    RENEW(nrhcon,int,nmat);

    RENEW(alcon,double,7*ntmat_*nmat);
    RENEW(nalcon,int,2*nmat);
    RENEW(alzero,double,nmat);

    matnameLen = 20*nmat; // added by yusuf
    RENEW(matname,char,20*nmat);
    RENEW(ielmat,int,ne);

    /* allocating space for the state variables */

    if(nstate_>0){
      xstate=NNEW(double,nstate_*mint_*ne);
    }

    if(iplas!=0){
      RENEW(plicon,double,(2*npmat_+1)*ntmat_*nmat);
      RENEW(nplicon,int,(ntmat_+1)*nmat);
      RENEW(plkcon,double,(2*npmat_+1)*ntmat_*nmat);
      RENEW(nplkcon,int,(ntmat_+1)*nmat);

      /* initializing the plastic state variables */

      for(i=0;i<ne;i++){
	if(nelcon[ielmat[i]*2-2]<-50){
	  for(j=0;j<mint_;j++){
	    xstate[13*mint_*i+13*j]=0;
	    for(k=1;k<4;k++){
	      xstate[13*mint_*i+13*j+k]=1;
	    }
	    for(k=4;k<13;k++){
	      xstate[13*mint_*i+13*j+k]=0;
	    }
	  }
	}
      }
    }
    else{
      free(plicon);free(nplicon);free(plkcon);free(nplkcon);
    }

    /* material orientation */

    if(norien > 0) {
      ornameLen = 20*norien; // added by yusuf
      RENEW(orname,char,20*norien);
      RENEW(ielorien,int,ne);
      RENEW(orab,double,7*norien);
    }
    else {
      free(orname);
      free(ielorien);
      free(orab);
    }

    /* amplitude definitions */

    if(nam > 0) {
      amnameLen = 20*nam; // added by yusuf
      RENEW(amname,char,20*nam);
      RENEW(namta,int,3*nam);
      RENEW(amta,double,2*namta[3*nam-2]);
    }
    else {
      free(amname);
      free(amta);
      free(namta);
      free(iamforc);
      free(iamload);
      free(iamboun);
    }

    if(ntrans > 0){
      RENEW(trab,double,7*ntrans);
    }
    else{free(trab);free(inotr);}

    if(ithermal == 0){free(t0);free(t1);}
    if((ithermal == 0)||(nam<=0)){free(iamt1);}

    if(ncs_>0){
      RENEW(ics,int,ncs_);
      free(dcs);}

  }
  else{

    /* reallocating space in all but the first step (>1) */

    RENEW(vold,double,4*nk);

    /* if the SPC boundary conditions were changed in the present step,
       they have to be rematched with those in the last step. Removed SPC 
       boundary conditions do not appear any more (this is different from
       forces and loads, where removed forces or loads are reset to zero;
       a removed SPC constraint does not have a numerical value any more) */
       
    reorder=NNEW(double,nboun);
    nreorder=NNEW(int,nboun);
    if(nbounold<nboun){
      RENEW(xbounold,double,nboun);
      RENEW(nodebounold,int,nboun);
      RENEW(ndirbounold,int,nboun);
    }
    FORTRAN(spcmatch,(xboun,nodeboun,ndirboun,&nboun,xbounold,nodebounold,
	      ndirbounold,&nbounold,ikboun,ilboun,vold,reorder,nreorder));
    RENEW(xbounold,double,nboun);
    RENEW(nodebounold,int,nboun);
    RENEW(ndirbounold,int,nboun);
    free(reorder); free(nreorder);

    /* for additional forces or loads in the present step, the
       corresponding slots in the force and load fields of the
       previous steps are initialized */

    RENEW(xforcold,double,nforc);
    for(i=nforcold;i<nforc;i++) xforcold[i]=0;

    RENEW(xloadold,double,2*nload);
    for(i=2*nloadold;i<2*nload;i++) xloadold[i]=0;

    if(ithermal>1){
	RENEW(xflowold,double,nflow);
	for(i=nflowold;i<nflow;i++) xflowold[i]=0;}

    if(ithermal==1){
      RENEW(t1old,double,nk);
    }
    
  }

  /* reallocating fields for all steps (>=1) */

  RENEW(co,double,3*nk);

  RENEW(nodeboun,int,nboun);
  RENEW(ndirboun,int,nboun);
  RENEW(xboun,double,nboun);
  RENEW(ikboun,int,nboun);
  RENEW(ilboun,int,nboun);
    
  RENEW(nodeforc,int,nforc);
  RENEW(ndirforc,int,nforc);
  RENEW(xforc,double,nforc);
  RENEW(ikforc,int,nforc);
  RENEW(ilforc,int,nforc);

  RENEW(nelemload,int,2*nload);
  sideloadLen = 5*nload_; // added by yusuf
  RENEW(sideload,char,5*nload);
  RENEW(xload,double,2*nload);

  RENEW(nodeprint,int,noprint);
  RENEW(nelemprint,int,neprint);

  RENEW(ipompc,int,nmpc);

  /* initial velocities and accelerations */

  if((nmethod == 4) || ((nmethod == 1) && (iperturb >= 2))) {
    RENEW(veold,double,4*nk);
  }
  else {free(veold);}

  if(nmethod == 4) {
    accold=NNEW(double,4*nk);
  }

  if(nam > 0) {
    RENEW(iamforc,int,nforc);
    RENEW(iamload,int,2*nload);
    RENEW(iamboun,int,nboun);
  }

  /* temperature loading */
  
  if(ithermal == 1){
      if((ne1d==0)&&(ne2d==0)){
	  RENEW(t0,double,nk);
	  RENEW(t1,double,nk);
      }
    if(nam > 0) {RENEW(iamt1,int,nk);}
  }

  if(ntrans > 0){
    RENEW(inotr,int,2*nk);
  }

  /* decascading MPC's and renumbering the equations: only necessary
  if MPC's changed */

  if((istep == 1)||(ntrans>0)) {

    /* decascading the MPC's */

    printf("Decascading the MPC's\n\n");

    callfrommain=1;
    cascade(ipompc,&coefmpc,&nodempc,&nmpc,
	    &mpcfree,nodeboun,ndirboun,&nboun,ikmpc,
	    ilmpc,ikboun,ilboun,&mpcend,&mpcmult,
	    labmpc,labmpcLen, &nk,&memmpc_,&icascade,&maxlenmpc,&callfrommain);

    /* reallocating nodempc and coefmpc */
 
    /* RENEW(nodempc,int,3*mpcend);
       RENEW(coefmpc,double,mpcend);*/
    labmpcLen = 20*nmpc; // added by yusuf
    RENEW(labmpc,char,20*nmpc);
    RENEW(ikmpc,int,nmpc);
    RENEW(ilmpc,int,nmpc);

    if(istep==1) nnn=NNEW(int,nk);
    else RENEW(nnn,int,nk);
    for(i=1;i<=nk;++i)
	nnn[i-1]=i;
	
    if(icascade==0){

	/* renumbering the nodes */
	
	printf("Renumbering the nodes to decrease the profile:\n");
	
	npn=NNEW(int,20*ne+mpcend);
	adj=NNEW(int,380*ne+mpcmult);
	xadj=NNEW(int,nk+1);
	iw=NNEW(int,3*nk+1);
	mmm=NNEW(int,nk);
	xnpn=NNEW(int,ne+nmpc+1);
	
#if defined(SPEC_CPU_NAGF95)
	FORTRAN(renumber,(&nk,kon,ipkon,lakon,&ne,ipompc,nodempc,&nmpc,nnn,
			  npn,adj,xadj,iw,mmm,xnpn, lakonLen));
#else
	FORTRAN(renumber,(&nk,kon,ipkon,lakon,&ne,ipompc,nodempc,&nmpc,nnn,
			  npn,adj,xadj,iw,mmm,xnpn));
#endif
	
	free(npn);free(adj);free(xadj);free(iw);free(mmm);free(xnpn);
    }
  }

  /* determining the matrix structure: changes if SPC's have changed */
  
  if(icascade==0) printf("Determining the structure of the matrix:\n");
  
  nactdof=NNEW(int,4*nk);
  
  if(isolver!=1) {
      mast1=NNEW(int,nzs);
      irow=NNEW(int,nzs);
  }
  
  if(ns[1]==-1){
      
      icol=NNEW(int,4*nk);
      jq=NNEW(int,4*nk+1);
      ikcol=NNEW(int,4*nk);
      ipointer=NNEW(int,4*nk);
      
      if(icascade==0){
	  mastruct(&nk,kon,ipkon,lakon,&ne,nodeboun,ndirboun,&nboun,ipompc,
		   nodempc,&nmpc,nactdof,icol,jq,&mast1,&irow,&isolver,&neq,nnn,
		   ikmpc,ilmpc,ikcol,ipointer,&nsky,&nzs,&nmethod,&ithermal);
      }
      else{neq=1;}
  }
  else{
      
      icol=NNEW(int,8*nk);
      jq=NNEW(int,8*nk+1);
      ikcol=NNEW(int,8*nk);
      ipointer=NNEW(int,8*nk);
      
      mastructcs(&nk,kon,ipkon,lakon,lakonLen, &ne,nodeboun,ndirboun,&nboun,
		 ipompc,nodempc,&nmpc,nactdof,icol,jq,&mast1,&irow,&isolver,
		 &neq,nnn,ikmpc,ilmpc,ikcol,ipointer,&nsky,&nzs,&nmethod,
		 ics,ns,labmpc, labmpcLen);}
  
  free(ikcol);free(ipointer);
  
  if(isolver!=1) {
      free(mast1);
      RENEW(irow,int,nzs);
  }

  /* nmethod=1: static analysis   */
  /* nmethod=2: frequency analysis  */
  /* nmethod=3: buckling analysis */
  /* nmethod=4: linear dynamic analysis */

  if((nmethod<=1)||(iperturb>1))
    {
      if(isolver==1){

	profile(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,nodempc,coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,icol,jq,&neq,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
             alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,&nsky,noelplab,noelplabLen,nodeflab,nodeflabLen,eei,&iexpl,
	     plicon,nplicon,plkcon,
             nplkcon,xstate,&npmat_,matname,matnameLen,&mint_,&ncmat_,&nstate_,ns,csab,
	     &nkon,ener,xbounold,xforcold,xloadold,&omold,bodyfold,amname,amnameLen,
	     amta,namta,&nam,iamforc,iamload,&iamom,&iambodyf,iamt1,iamboun,
             &ttime,output,outputLen);

      }

      else if(iperturb<2){
	
	prespooles(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,nodempc,coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,&icol,jq,&irow,&neq,&nzl,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
	     alcon,nalcon,alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,&nzs,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,adb,aub,noelplab,noelplabLen,nodeflab,nodeflabLen,eei,&iexpl,plicon,
             nplicon,plkcon,nplkcon,xstate,&npmat_,matname,matnameLen,
	     &isolver,&mint_,&ncmat_,&nstate_,ns,csab,&nkon,ener,
             xbounold,xforcold,xloadold,&omold,bodyfold,amname,amnameLen,amta,namta,
             &nam,iamforc,iamload,&iamom,&iambodyf,iamt1,iamboun,&ttime,
             output,outputLen);

      }

      else{

	mpcinfo[0]=memmpc_;mpcinfo[1]=mpcfree;mpcinfo[2]=icascade;
	mpcinfo[3]=maxlenmpc;

	nonlingeo(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,&nodempc,&coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,&icol,jq,&irow,&neq,&nzl,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
	     alcon,nalcon,alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,&nzs,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,adb,aub,noelplab,noelplabLen,nodeflab,nodeflabLen,&idrct,&jmax,
	     &jout,&tinc,&tper,&tmin,&tmax,eei,xbounold,xforcold,xloadold,
	     &omold,bodyfold,veold,accold,amname,amnameLen,amta,namta,
	     &nam,iamforc,iamload,&iamom,&iambodyf,iamt1,&alpha,&haftol,
             &iexpl,iamboun,plicon,nplicon,plkcon,nplkcon,
	     xstate,&npmat_,&istep,&ttime,matname,matnameLen,&qaold,&mint_,
	     &isolver,&ncmat_,&nstate_,&iumat,ns,csab,&nkon,ener,
	     mpcinfo,nnn,output,outputLen,nodeflow,iamflow,
             xflow,shcon,nshcon,cocon,ncocon,physcon,xflowold,&nflow,ctrl);

	memmpc_=mpcinfo[0];mpcfree=mpcinfo[1];icascade=mpcinfo[2];
        maxlenmpc=mpcinfo[3];


      }
    }
  else if(nmethod==2)
    {  
    }
  else if(nmethod==3)
    {
    }
  else if(nmethod==4)
    {
    }

  free(nactdof);
  free(icol);
  free(jq);
  if(isolver!=1){free(irow);}

  /* deleting the perturbation loads and temperatures */

  if((iperturb == 1)&&(nmethod==3)) {
    nforc=0;
    nload=0;
    om=0.;
    for(k=0;k<3;++k){
      bodyf[k]=0.;
    }
    if(ithermal == 1) {
      for(k=0;k<nk;++k){
	t1[k]=t0[k];
      }
    }
  }

  else{
    nbounold=nboun;
    nforcold=nforc;
    nloadold=nload;
    if(ithermal>1)nflowold=nflow;

    /* resetting the amplitude to none except for time=total time amplitudes */

    if(nam > 0) {
	for (i=0;i<nboun;i++) {
	    if(namta[3*iamboun[i]-1]!=1) iamboun[i]=0;
	}
	for (i=0;i<nforc;i++){
	    if(namta[3*iamforc[i]-1]!=1) iamforc[i]=0;
	}
	for (i=0;i<2*nload;i++){
	    if(namta[3*iamload[i]-1]!=1) iamload[i]=0;
	}
	if(namta[3*iamom-1]!=1) iamom=0;
	if(namta[3*iambodyf-1]!=1) iambodyf=0;
	if(ithermal==1) {
	    if(namta[3*iamt1[i]-1]!=1) iamt1[i]=0;
	}
    }
  }

}

 FORTRAN(frdclose,());

 return 0;
      
}

invivoCalculiX_main_145

Real time: 2.251224e+06 -- Predicted time: 2.034871e+12

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	2.034871e+12	2.310292e+06	99.9

                /*     CalculiX - A 3-dimensional finite element program                   */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                    */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <misc.h>
#include <FrontMtx.h>
#include <SymbFac.h>
#include "CalculiX.h"

void spooles(double *ad, double *au, double *b, int *icol, int *irow, 
	     int *neq, int *nzs){
  
  int ipoint,ipo;
  DenseMtx        *mtxB, *mtxX ;
  Chv             *rootchv ;
  ChvManager      *chvmanager  ;
  SubMtxManager   *mtxmanager  ;
  FrontMtx        *frontmtx ;
  InpMtx          *mtxA ;
  double          tau = 100.;
  double          cpus[10] ;
  ETree           *frontETree ;
  FILE            *msgFile ;
  Graph           *graph ;
  int             jrow, jrhs, msglvl=0, ncol, nedges,error, 
                  nent, neqns, nrhs, nrow, pivotingflag=1, seed=7892713, 
                  symmetryflag=0, type=1,row,col,maxdomainsize,maxzeros,
                  maxsize;
  int             *newToOld, *oldToNew ;
  int             stats[20] ;
  IV              *newToOldIV, *oldToNewIV ;
  IVL             *adjIVL, *symbfacIVL ;

  /* solving the system of equations using spooles */
#ifndef SPEC_CPU
  printf("Solving the system of equations using spooles\n\n");
#endif
/*
   --------------------------------------------------
   all-in-one program to solve A X = B
   (1) read in matrix entries and form DInpMtx object
   (2) form Graph object
   (3) order matrix and form front tree
   (4) get the permutation, permute the matrix and 
       front tree and get the symbolic factorization
   (5) compute the numeric factorization
   (6) read in right hand side entries
   (7) compute the solution

   created -- 98jun04, cca
   --------------------------------------------------
*/
    if ( (msgFile = fopen("spooles.out", "a")) == NULL ) {
      fprintf(stderr, "\n fatal error in spooles.c"
	      "\n unable to open file spooles.out\n") ;
    }
/*
   --------------------------------------------
   STEP 1: read the entries from the input file 
           and create the InpMtx object
   --------------------------------------------
*/
    nrow=*neq;
    ncol=*neq;
    nent=*nzs+*neq;
    neqns=nrow;
    ipoint=0;
    mtxA = InpMtx_new() ;
    InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, neqns) ;
    for(row=0;row<nrow;row++){
      InpMtx_inputRealEntry(mtxA,row,row,ad[row]);
      for(ipo=ipoint;ipo<ipoint+icol[row];ipo++){
	col=irow[ipo]-1;
	InpMtx_inputRealEntry(mtxA,row,col,au[ipo]);
      }
      ipoint=ipoint+icol[row];
    }
	
    InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n input matrix") ;
      InpMtx_writeForHumanEye(mtxA, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   -------------------------------------------------
   STEP 2 : find a low-fill ordering
   (1) create the Graph object
   (2) order the graph using multiple minimum degree
   -------------------------------------------------
*/
    graph = Graph_new() ;
    adjIVL = InpMtx_fullAdjacency(mtxA) ;
    nedges = IVL_tsize(adjIVL) ;
    Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL,
		NULL, NULL) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n graph of the input matrix") ;
      Graph_writeForHumanEye(graph, msgFile) ;
      fflush(msgFile) ;
    }
    /*maxdomainsize=neqns/100;*/
    /* frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ; */
    /* frontETree = orderViaND(graph,maxdomainsize,seed,msglvl,msgFile); */
    /*frontETree = orderViaMS(graph,maxdomainsize,seed,msglvl,msgFile);*/
    maxdomainsize=800;maxzeros=1000;maxsize=64;
    frontETree=orderViaBestOfNDandMS(graph,maxdomainsize,maxzeros,
      maxsize,seed,msglvl,msgFile);
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n front tree from ordering") ;
      ETree_writeForHumanEye(frontETree, msgFile) ;
      fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
   -----------------------------------------------------
   STEP 3: get the permutation, permute the matrix and 
           front tree and get the symbolic factorization
   -----------------------------------------------------
*/
    oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
    oldToNew = IV_entries(oldToNewIV) ;
    newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
    newToOld   = IV_entries(newToOldIV) ;
    ETree_permuteVertices(frontETree, oldToNewIV) ;
    InpMtx_permute(mtxA, oldToNew, oldToNew) ;
    InpMtx_mapToUpperTriangle(mtxA) ;
    InpMtx_changeCoordType(mtxA,INPMTX_BY_CHEVRONS);
    InpMtx_changeStorageMode(mtxA,INPMTX_BY_VECTORS);
    symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n old-to-new permutation vector") ;
      IV_writeForHumanEye(oldToNewIV, msgFile) ;
      fprintf(msgFile, "\n\n new-to-old permutation vector") ;
      IV_writeForHumanEye(newToOldIV, msgFile) ;
      fprintf(msgFile, "\n\n front tree after permutation") ;
      ETree_writeForHumanEye(frontETree, msgFile) ;
      fprintf(msgFile, "\n\n input matrix after permutation") ;
      InpMtx_writeForHumanEye(mtxA, msgFile) ;
      fprintf(msgFile, "\n\n symbolic factorization") ;
      IVL_writeForHumanEye(symbfacIVL, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   ------------------------------------------
   STEP 4: initialize the front matrix object
   ------------------------------------------
*/
    frontmtx = FrontMtx_new() ;
    mtxmanager = SubMtxManager_new() ;
    SubMtxManager_init(mtxmanager, NO_LOCK, 0) ;
    FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, symmetryflag, 
		  FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, 0, NULL, 
		  mtxmanager, msglvl, msgFile) ;
/*--------------------------------------------------------------------*/
/*
   -----------------------------------------
   STEP 5: compute the numeric factorization
   -----------------------------------------
*/
    chvmanager = ChvManager_new() ;
    ChvManager_init(chvmanager, NO_LOCK, 1) ;
    DVfill(10, cpus, 0.0) ;
    IVfill(20, stats, 0) ;
    rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, 0.0, chvmanager,
				    &error,cpus, stats, msglvl, msgFile) ;
    ChvManager_free(chvmanager) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n factor matrix") ;
      FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
      fflush(msgFile) ;
    }
    if ( rootchv != NULL ) {
      fprintf(msgFile, "\n\n matrix found to be singular\n") ;
      exit(-1) ;
    }
    if(error>=0){
      fprintf(msgFile,"\n\nerror encountered at front %d",error);
      exit(-1);
    }
/*--------------------------------------------------------------------*/
/*
   --------------------------------------
   STEP 6: post-process the factorization
   --------------------------------------
*/
    FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n factor matrix after post-processing") ;
      FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   -----------------------------------------
   STEP 7: read the right hand side matrix B
   -----------------------------------------
*/
    nrhs=1;
    mtxB = DenseMtx_new() ;
    DenseMtx_init(mtxB, type, 0, 0, neqns, nrhs, 1, neqns) ;
    DenseMtx_zero(mtxB) ;
    for ( jrow = 0 ; jrow < nrow ; jrow++ ) {
      for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
	DenseMtx_setRealEntry(mtxB, jrow, jrhs, b[jrow]) ;
      }
    }

    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n rhs matrix in original ordering") ;
      DenseMtx_writeForHumanEye(mtxB, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   ---------------------------------------------------------
   STEP 8: permute the right hand side into the new ordering
   ---------------------------------------------------------
*/
    DenseMtx_permuteRows(mtxB, oldToNewIV) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n right hand side matrix in new ordering") ;
      DenseMtx_writeForHumanEye(mtxB, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   -------------------------------
   STEP 9: solve the linear system
   -------------------------------
*/
    mtxX = DenseMtx_new() ;
    DenseMtx_init(mtxX, type, 0, 0, neqns, nrhs, 1, neqns) ;
    DenseMtx_zero(mtxX) ;
    FrontMtx_solve(frontmtx, mtxX, mtxB, mtxmanager,cpus, msglvl, msgFile) ;
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n solution matrix in new ordering") ;
      DenseMtx_writeForHumanEye(mtxX, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/
/*
   --------------------------------------------------------
   STEP 10: permute the solution into the original ordering
   --------------------------------------------------------
*/
    DenseMtx_permuteRows(mtxX, newToOldIV) ;
    /* *ipb=DenseMtx_entries(mtxX); */
    if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n solution matrix in original ordering") ;
      DenseMtx_writeForHumanEye(mtxX, msgFile) ;
      fflush(msgFile) ;
    }
/*--------------------------------------------------------------------*/

    for ( jrow = 0 ; jrow < nrow ; jrow++ ) {
      b[jrow]=DenseMtx_entries(mtxX)[jrow];
    }

/*
   -----------
   free memory
   -----------
*/
    FrontMtx_free(frontmtx) ;
    DenseMtx_free(mtxX) ;
    DenseMtx_free(mtxB) ;
    IV_free(newToOldIV) ;
    IV_free(oldToNewIV) ;
    InpMtx_free(mtxA) ;
    ETree_free(frontETree) ;
    IVL_free(symbfacIVL) ;
    SubMtxManager_free(mtxmanager) ;
    Graph_free(graph) ;

/*--------------------------------------------------------------------*/

    fclose(msgFile);
    
  return;
}

invivospooles_spooles_86

Real time: 2.362836e+06 -- Predicted time: 2.193946e+06

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	2.193946e+06	2.350628e+06	6.6

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Utilities_src_Utilities_newsort_IV2DVqsortUp_1402

Real time: 2.569520e+06 -- Predicted time: 2.751744e+06

Callcount: 711

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
135	### 1	316.611859838275	4.765000e+03	5.936000e+03	19.7
120	### 2	670.490272373541	1.854000e+03	1.028000e+03	44.5

                CODE NOT FOUND -> THIS CODELET NOT IN regions.csv?

invivoSPOOLES_Chv_src_Chv_update_Chv_updateS_687

Real time: 4.991592e+06 -- Predicted time: 5.313286e+06

Callcount: 66

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
2	### 1	19.966294490748	8.058000e+04	7.630800e+04	5.3
25	### 2	14.4454295025995	2.091150e+05	2.061920e+05	1.3
28	### 3	55.5403669724771	1.230900e+04	8.720000e+03	29.1

                !
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine e_c3d(co,nk,konl,lakonl,p1,p2,omx,bodyfx,ibod,s,sm,f,
     &  ff,nelem,nmethod,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
     &  ielmat,ielorien,norien,orab,ntmat_,
     &  t0,t1,ithermal,prestr,iprestr,vold,iperturb,nelemload,
     &  sideload,xload,nload,idist,sti,stx,eei,iexpl,plicon,
     &  nplicon,plkcon,nplkcon,xstiff,npmat_,dtime,
     &  matname,mint_,ncmat_,mass,stiffness,buckling,rhs,intscheme)
!
!     computation of the element matrix and rhs for the element with
!     the topology in konl
!
!     f: rhs with temperature and eigenstress contribution: for linear 
!        calculations only
!     ff: rhs without temperature and eigenstress contribution
!
!     nmethod=0: check for positive Jacobian
!     nmethod=1: stiffness matrix + right hand side
!     nmethod=2: stiffness matrix + mass matrix
!     nmethod=3: static stiffness + buckling stiffness
!     nmethod=4: right hand side (linear, iperturb=0)
!
      implicit none
!
      logical mass,stiffness,buckling,rhs
!
      character*5 sideload(*)
      character*8 lakonl
      character*20 matname(*),amat
!
      integer konl(20),ifaceq(8,6),nelemload(2,*),nk,ibod,nelem,nmethod,
     &  mattyp,ithermal,iprestr,iperturb,nload,idist,i,j,k,l,i1,i2,j1,
     &  k1,l1,ii,jj,ii1,jj1,id,ipointer,ig,m1,m2,m3,m4,kk,
     &  nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(*),ielorien(*),
     &  ntmat_,nope,nopes,norien,icmdl,ihyper,iexpl,kode,imat,mint2d,
     &  mint3d,mint_,ifacet(6,4),nopev,iorien,istiff,ncmat_,
     &  ifacew(8,5),intscheme,n,ipointeri,ipointerj,iii1,jjj1,n1
!
      integer nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
      real*8 co(3,*),xl(3,20),shp(4,20),
     &  s(60,60),w(3,3),p1(3),p2(3),f(60),bodyf(3),bodyfx(3),ff(60),
     &  bf(3),q(3),shpj(4,20),elcon(0:ncmat_,ntmat_,*),
     &  rhcon(0:1,ntmat_,*),xkl(3,3),
     &  alcon(0:6,ntmat_,*),alzero(*),orab(7,*),t0(*),t1(*),
     &  anisox(3,3,3,3),beta(6),prestr(6,*),voldl(3,20),vo(3,3),
     &  xl2(3,8),xsj2(3),shp2(4,8),vold(0:3,*),xload(2,*),v(3,3,3,3),
     &  om,omx,e,un,al,um,xi,et,ze,tt,const,xsj,xsjj,sm(60,60),
     &  sti(6,mint_,*),stx(6,mint_,*),s11,s22,s33,s12,s13,s23,s11b,
     &  s22b,s33b,s12b,s13b,s23b,eei(6,mint_,*),t0l,t1l,stre(6),
     &  senergy,senergyb,rho,elas(21),alph(6),summass,summ,
     &  sume,factorm,factore,alp,elconloc(21),eth(6),exx,eyy,ezz,
     &  exy,exz,eyz,am1,weight,pgauss(3),dmass,xl1(3,8),term
!
      real*8 gauss2d1(2,1),gauss2d2(2,4),gauss2d3(2,9),gauss2d4(2,1),
     &  gauss2d5(2,3),gauss3d1(3,1),gauss3d2(3,8),gauss3d3(3,27),
     &  gauss3d4(3,1),gauss3d5(3,4),gauss3d6(3,15),gauss3d7(3,2),
     &  gauss3d8(3,9),gauss3d9(3,18),weight2d1(1),weight2d2(4),
     &  weight2d3(9),weight2d4(1),weight2d5(3),weight3d1(1),
     &  weight3d2(8),weight3d3(27),weight3d4(1),weight3d5(4),
     &  weight3d6(15),weight3d7(2),weight3d8(9),weight3d9(18)
!
      real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
     &  xstiff(21,mint_,*),
     &  plconloc(82),dtime
!
      include "gauss.f"
!
      data ifaceq /4,3,2,1,11,10,9,12,
     &            5,6,7,8,13,14,15,16,
     &            1,2,6,5,9,18,13,17,
     &            2,3,7,6,10,19,14,18,
     &            3,4,8,7,11,20,15,19,
     &            4,1,5,8,12,17,16,20/
      data ifacet /1,3,2,7,6,5,
     &             1,2,4,5,9,8,
     &             2,3,4,6,10,9,
     &             1,4,3,8,10,7/
      data ifacew /1,3,2,9,8,7,0,0,
     &             4,5,6,10,11,12,0,0,
     &             1,2,5,4,7,14,10,13,
     &             2,3,6,5,8,15,11,14,
     &             4,6,3,1,12,15,9,13/
!
c      if(nmethod.eq.5) then
c         intscheme=1
c         nmethod=2
c      else
c         intscheme=0
c      endif
c!
c      mass=.false.
c      stiffness=.false.
c      buckling=.false.
c      rhs=.false.
c!
c      if(nmethod.eq.1) then
c         stiffness=.true.
c         rhs=.true.
c      elseif(nmethod.eq.2) then
c         mass=.true.
c         stiffness=.true.
c      elseif(nmethod.eq.3) then
c         stiffness=.true.
c         buckling=.true.
c      elseif(nmethod.eq.4) then
c         rhs=.true.
c      endif
!
      summass=0.d0
!
      imat=ielmat(nelem)
      amat=matname(imat)
      if(norien.gt.0) then
         iorien=ielorien(nelem)
      else
         iorien=0
      endif
!
      if(lakonl(4:4).eq.'2') then
         nope=20
         nopev=8
         nopes=8
      elseif(lakonl(4:4).eq.'8') then
         nope=8
         nopev=8
         nopes=4
      elseif(lakonl(4:5).eq.'10') then
         nope=10
         nopev=4
         nopes=6
      elseif(lakonl(4:4).eq.'4') then
         nope=4
         nopev=4
         nopes=3
      elseif(lakonl(4:5).eq.'15') then
         nope=15
         nopev=6
      else
         nope=6
         nopev=6
      endif
!
      if(intscheme.eq.0) then
         if(lakonl(4:5).eq.'8R') then
            mint2d=1
            mint3d=1
         elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
            mint2d=4
            mint3d=8
         elseif(lakonl(4:4).eq.'2') then
            mint2d=9
            mint3d=27
         elseif(lakonl(4:5).eq.'10') then
            mint2d=3
            mint3d=4
         elseif(lakonl(4:4).eq.'4') then
            mint2d=1
            mint3d=1
         elseif(lakonl(4:5).eq.'15') then
            mint3d=9
         else
            mint3d=2
         endif
      else
         if((lakonl(4:4).eq.'8').or.(lakonl(4:4).eq.'2')) then
            mint3d=27
         elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4')) then
            mint3d=15
         else
            mint3d=18
         endif
      endif
!
!     computation of the coordinates of the local nodes
!
      do i=1,nope
        do j=1,3
          xl(j,i)=co(j,konl(i))
        enddo
      enddo
!
      if(nelcon(1,imat).lt.0) then
         ihyper=1
      else
         ihyper=0
      endif
!
!       initialisation for distributed forces
!
      if(rhs) then
        if(idist.ne.0) then
          do i=1,3*nope
            f(i)=0.d0
            ff(i)=0.d0
          enddo
        endif
      endif
!
!     displacements for 2nd order static and modal theory
!
      if((iperturb.ne.0).and.stiffness.and.(.not.buckling)) then
         do i1=1,nope
            do i2=1,3
               voldl(i2,i1)=vold(i2,konl(i1))
            enddo
         enddo
      endif
!
!     initialisation of sm
!
      if(mass.or.buckling) then
        do i=1,3*nope
          do j=1,3*nope
            sm(i,j)=0.d0
          enddo
        enddo
      endif
!
!     initialisation of s
!
      do i=1,3*nope
        do j=1,3*nope
          s(i,j)=0.d0
        enddo
      enddo
!
!     computation of the matrix: loop over the Gauss points
!
      do kk=1,mint3d
         if(intscheme.eq.0) then
            if(lakonl(4:5).eq.'8R') then
               xi=gauss3d1(1,kk)
               et=gauss3d1(2,kk)
               ze=gauss3d1(3,kk)
               weight=weight3d1(kk)
            elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) 
     &              then
               xi=gauss3d2(1,kk)
c               if(nope.eq.20) xi=xi+1.d0
               et=gauss3d2(2,kk)
               ze=gauss3d2(3,kk)
               weight=weight3d2(kk)
            elseif(lakonl(4:4).eq.'2') then
c               xi=gauss3d3(1,kk)+1.d0
               xi=gauss3d3(1,kk)
               et=gauss3d3(2,kk)
               ze=gauss3d3(3,kk)
               weight=weight3d3(kk)
            elseif(lakonl(4:5).eq.'10') then
               xi=gauss3d5(1,kk)
               et=gauss3d5(2,kk)
               ze=gauss3d5(3,kk)
               weight=weight3d5(kk)
            elseif(lakonl(4:4).eq.'4') then
               xi=gauss3d4(1,kk)
               et=gauss3d4(2,kk)
               ze=gauss3d4(3,kk)
               weight=weight3d4(kk)
            elseif(lakonl(4:5).eq.'15') then
               xi=gauss3d8(1,kk)
               et=gauss3d8(2,kk)
               ze=gauss3d8(3,kk)
               weight=weight3d8(kk)
            else
               xi=gauss3d7(1,kk)
               et=gauss3d7(2,kk)
               ze=gauss3d7(3,kk)
               weight=weight3d7(kk)
            endif
         else
            if((lakonl(4:4).eq.'8').or.(lakonl(4:4).eq.'2')) then
c               xi=gauss3d3(1,kk)+1.d0
               xi=gauss3d3(1,kk)
               et=gauss3d3(2,kk)
               ze=gauss3d3(3,kk)
               weight=weight3d3(kk)
            elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4')) then
               xi=gauss3d6(1,kk)
               et=gauss3d6(2,kk)
               ze=gauss3d6(3,kk)
               weight=weight3d6(kk)
            else
               xi=gauss3d9(1,kk)
               et=gauss3d9(2,kk)
               ze=gauss3d9(3,kk)
               weight=weight3d9(kk)
            endif
         endif
!
!           calculation of the shape functions and their derivatives
!           in the gauss point
!
         if(nope.eq.20) then
            call shape20h(xi,et,ze,xl,xsj,shp)
         elseif(nope.eq.8) then
            call shape8h(xi,et,ze,xl,xsj,shp)
         elseif(nope.eq.10) then
            call shape10tet(xi,et,ze,xl,xsj,shp)
         elseif(nope.eq.4) then
            call shape4tet(xi,et,ze,xl,xsj,shp)
         elseif(nope.eq.15) then
            call shape15w(xi,et,ze,xl,xsj,shp)
         else
            call shape6w(xi,et,ze,xl,xsj,shp)
         endif
!
!           check the jacobian determinant
!
         if(xsj.lt.1.d-20) then
            write(*,*) '*WARNING in e_c3d: nonpositive jacobian'
            write(*,*) '         determinant in element',nelem
            write(*,*)
            xsj=dabs(xsj)
            nmethod=0
         endif
!
         if((iperturb.ne.0).and.stiffness.and.(.not.buckling))
     &        then
!
!              stresses for 2nd order static and modal theory
!
            s11=sti(1,kk,nelem)
            s22=sti(2,kk,nelem)
            s33=sti(3,kk,nelem)
            s12=sti(4,kk,nelem)
            s13=sti(5,kk,nelem)
            s23=sti(6,kk,nelem)
         endif
!
!           calculating the temperature in the integration
!           point
!
         t0l=0.d0
         t1l=0.d0
         if(ithermal.eq.1) then
            if(lakonl(4:5).eq.'8 ') then
               do i1=1,nope
                  t0l=t0l+t0(konl(i1))/8.d0
                  t1l=t1l+t1(konl(i1))/8.d0
               enddo
            elseif(lakonl(4:6).eq.'20 ') then
               call lintemp(t0,t1,konl,nope,kk,t0l,t1l)
            else
               do i1=1,nope
                  t0l=t0l+shp(4,i1)*t0(konl(i1))
                  t1l=t1l+shp(4,i1)*t1(konl(i1))
               enddo
            endif
         elseif(ithermal.ge.2) then
            if(lakonl(4:5).eq.'8 ') then
               do i1=1,nope
                  t0l=t0l+t0(konl(i1))/8.d0
                  t1l=t1l+vold(0,konl(i1))/8.d0
               enddo
            elseif(lakonl(4:6).eq.'20 ') then
               call lintemp_th(t0,vold,konl,nope,kk,t0l,t1l)
            else
               do i1=1,nope
                  t0l=t0l+shp(4,i1)*t0(konl(i1))
                  t1l=t1l+shp(4,i1)*vold(0,konl(i1))
               enddo
            endif
         endif
         tt=t1l-t0l
!
!           calculating the coordinates of the integration point
!           for material orientation purposes (for cylindrical
!           coordinate systems)
!
         if(iorien.gt.0) then
            do j=1,3
               pgauss(j)=0.d0
               do i1=1,nope
                  pgauss(j)=pgauss(j)+shp(4,i1)*co(j,konl(i1))
               enddo
            enddo
         endif
!
!           for deformation plasticity: calculating the Jacobian
!           and the inverse of the deformation gradient
!           needed to convert the stiffness matrix in the spatial
!           frame of reference to the material frame
!
         kode=nelcon(1,imat)
!
!           material data and local stiffness matrix
!
         istiff=1
         call materialdata(elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
     &        imat,amat,iorien,pgauss,orab,ntmat_,elas,alph,rho,
     &        nelem,ithermal,alzero,mattyp,t0l,t1l,
     &        ihyper,istiff,elconloc,eth,kode,plicon,
     &        nplicon,plkcon,nplkcon,npmat_,
     &        plconloc,mint_,dtime,nelem,kk,
     &        xstiff,ncmat_)
!
         if(mattyp.eq.1) then
            e=elas(1)
            un=elas(2)
            um=e/(1.d0+un)
            al=un*um/(1.d0-2.d0*un)
            um=um/2.d0
         elseif(mattyp.eq.2) then
            call orthotropic(elas,anisox)
         else
            call anisotropic(elas,anisox)
         endif
!
!           initialisation for the body forces
!
         om=omx*rho
         if(rhs) then
            if(ibod.ne.0) then
               do ii=1,3
                  bodyf(ii)=bodyfx(ii)*rho
               enddo
            endif
         endif
!
         if(rhs) then
!
!             information for the rhs
!
!             residual stresses
!
            if((iprestr.eq.1).or.(ithermal.eq.1)) then
               if(iprestr.eq.0) then
                  do ii=1,6
                     beta(ii)=0.d0
                  enddo
               else
                  do ii=1,6
                     beta(ii)=-prestr(ii,nelem)
                  enddo
               endif
            endif
!
!             calculation of the thermal stresses in an undeformed body 
!             assumption; beta corresponds to initial stresses.
!
            if(ithermal.eq.1) then
               if(ihyper.eq.0) then
                  icmdl=2
                  call linel(ithermal,mattyp,beta,al,um,am1,alph,tt,
     &                 elas,icmdl,exx,eyy,ezz,exy,exz,eyz,stre,
     &                 anisox)
               endif
            endif
!
         elseif(buckling) then
!
!              buckling stresses
!
            s11b=stx(1,kk,nelem)
            s22b=stx(2,kk,nelem)
            s33b=stx(3,kk,nelem)
            s12b=stx(4,kk,nelem)
            s13b=stx(5,kk,nelem)
            s23b=stx(6,kk,nelem)
!
         endif
!
!           incorporating the jacobian determinant in the shape
!           functions
!
         xsjj=dsqrt(xsj)
         do i1=1,nope
            shpj(1,i1)=shp(1,i1)*xsjj
            shpj(2,i1)=shp(2,i1)*xsjj
            shpj(3,i1)=shp(3,i1)*xsjj
            shpj(4,i1)=shp(4,i1)*xsj
         enddo
!
!           determination of the stiffness, and/or mass and/or
!           buckling matrix
!
         if(stiffness.or.mass.or.buckling) then
!
            if((iperturb.eq.0).or.buckling)
     &           then
               jj1=1
               do jj=1,nope
!
                  ii1=1
                  do ii=1,jj
!
!                   all products of the shape functions for a given ii
!                   and jj
!
                     do i1=1,3
                        do j1=1,3
                           w(i1,j1)=shpj(i1,ii)*shpj(j1,jj)
                        enddo
                     enddo
!
!                   the following section calculates the static
!                   part of the stiffness matrix which, for buckling 
!                   calculations, is done in a preliminary static
!                   call
!
                     if(.not.buckling) then
!
                        if(mattyp.eq.1) then
!
                           s(ii1,jj1)=s(ii1,jj1)+(al*w(1,1)+
     &                          um*(2.d0*w(1,1)+w(2,2)+w(3,3)))*weight
                           s(ii1,jj1+1)=s(ii1,jj1+1)+(al*w(1,2)+
     &                          um*w(2,1))*weight
                           s(ii1,jj1+2)=s(ii1,jj1+2)+(al*w(1,3)+
     &                          um*w(3,1))*weight
                           s(ii1+1,jj1)=s(ii1+1,jj1)+(al*w(2,1)+
     &                          um*w(1,2))*weight
                           s(ii1+1,jj1+1)=s(ii1+1,jj1+1)+(al*w(2,2)+
     &                          um*(2.d0*w(2,2)+w(1,1)+w(3,3)))*weight
                           s(ii1+1,jj1+2)=s(ii1+1,jj1+2)+(al*w(2,3)+
     &                          um*w(3,2))*weight
                           s(ii1+2,jj1)=s(ii1+2,jj1)+(al*w(3,1)+
     &                          um*w(1,3))*weight
                           s(ii1+2,jj1+1)=s(ii1+2,jj1+1)+(al*w(3,2)+
     &                          um*w(2,3))*weight
                           s(ii1+2,jj1+2)=s(ii1+2,jj1+2)+(al*w(3,3)+
     &                          um*(2.d0*w(3,3)+w(2,2)+w(1,1)))*weight
!
                        elseif(mattyp.eq.2) then
!
                           s(ii1,jj1)=s(ii1,jj1)+(elas(1)*w(1,1)+
     &                          elas(7)*w(2,2)+elas(8)*w(3,3))*weight
                           s(ii1,jj1+1)=s(ii1,jj1+1)+(elas(2)*w(1,2)+
     &                          elas(7)*w(2,1))*weight
                           s(ii1,jj1+2)=s(ii1,jj1+2)+(elas(4)*w(1,3)+
     &                          elas(8)*w(3,1))*weight
                           s(ii1+1,jj1)=s(ii1+1,jj1)+(elas(7)*w(1,2)+
     &                          elas(2)*w(2,1))*weight
                           s(ii1+1,jj1+1)=s(ii1+1,jj1+1)+
     &                          (elas(7)*w(1,1)+
     &                          elas(3)*w(2,2)+elas(9)*w(3,3))*weight
                           s(ii1+1,jj1+2)=s(ii1+1,jj1+2)+
     &                          (elas(5)*w(2,3)+
     &                          elas(9)*w(3,2))*weight
                           s(ii1+2,jj1)=s(ii1+2,jj1)+
     &                          (elas(8)*w(1,3)+
     &                          elas(4)*w(3,1))*weight
                           s(ii1+2,jj1+1)=s(ii1+2,jj1+1)+
     &                          (elas(9)*w(2,3)+
     &                          elas(5)*w(3,2))*weight
                           s(ii1+2,jj1+2)=s(ii1+2,jj1+2)+
     &                          (elas(8)*w(1,1)+
     &                          elas(9)*w(2,2)+elas(6)*w(3,3))*weight
!
                        else
!
                           do i1=1,3
                              do j1=1,3
                                 do k1=1,3
                                    do l1=1,3
                                       s(ii1+i1-1,jj1+j1-1)=
     &                                      s(ii1+i1-1,jj1+j1-1)
     &                                      +anisox(i1,k1,j1,l1)
     &                                      *w(k1,l1)*weight
                                    enddo
                                 enddo
                              enddo
                           enddo
!
                        endif
!
!                     mass matrix
!
                        if(mass) then
                           sm(ii1,jj1)=sm(ii1,jj1)
     &                          +rho*shpj(4,ii)*shp(4,jj)*weight
                           sm(ii1+1,jj1+1)=sm(ii1,jj1)
                           sm(ii1+2,jj1+2)=sm(ii1,jj1)
                        endif
!
                     else
!
!                     buckling matrix  
!
                        senergyb=
     &                       (s11b*w(1,1)+s12b*(w(1,2)+w(2,1))
     &                       +s13b*(w(1,3)+w(3,1))+s22b*w(2,2)
     &                       +s23b*(w(2,3)+w(3,2))+s33b*w(3,3))*weight
                        sm(ii1,jj1)=sm(ii1,jj1)-senergyb
                        sm(ii1+1,jj1+1)=sm(ii1+1,jj1+1)-senergyb
                        sm(ii1+2,jj1+2)=sm(ii1+2,jj1+2)-senergyb
!
                     endif
!
                     ii1=ii1+3
                  enddo
                  jj1=jj1+3
               enddo
            else
!
!               stiffness matrix for static and modal
!               2nd order calculations
!
!               large displacement stiffness
!               
               do i1=1,3
                  do j1=1,3
                     vo(i1,j1)=0.d0
                     do k1=1,nope
                        vo(i1,j1)=vo(i1,j1)+shp(j1,k1)*voldl(i1,k1)
                     enddo
                  enddo
               enddo
!
               if(mattyp.eq.1) then
                  call wcoef(v,vo,al,um)
               endif
!
!               calculating the total mass of the element for
!               lumping purposes: only for explicit nonlinear
!               dynamic calculations
!
               if(mass.and.(iexpl.eq.1)) then
                  summass=summass+rho*xsj
               endif
!
               jj1=1
               do jj=1,nope
!
                  ii1=1
                  do ii=1,jj
!
!                   all products of the shape functions for a given ii
!                   and jj
!
                     do i1=1,3
                        do j1=1,3
                           w(i1,j1)=shpj(i1,ii)*shpj(j1,jj)
                        enddo
                     enddo
!
                     if(mattyp.eq.1) then
!
                        do m1=1,3
                           do m2=1,3
                              do m3=1,3
                                 do m4=1,3
                                    s(ii1+m2-1,jj1+m1-1)=
     &                                   s(ii1+m2-1,jj1+m1-1)
     &                                   +v(m4,m3,m2,m1)*w(m4,m3)*weight
                                 enddo
                              enddo
                           enddo
                        enddo
!                      
                     elseif(mattyp.eq.2) then
!
                        call orthonl(w,vo,elas,s,ii1,jj1,weight)
!
                     else
!
                      do i1=1,3
                        iii1=ii1+i1-1
                        do j1=1,3
                          jjj1=jj1+j1-1
                          do k1=1,3
                            do l1=1,3
                              s(iii1,jjj1)=s(iii1,jjj1)
     &                         +anisox(i1,k1,j1,l1)*w(k1,l1)*weight
                              do m1=1,3
                                s(iii1,jjj1)=s(iii1,jjj1)
     &                              +anisox(i1,k1,m1,l1)*w(k1,l1)
     &                                 *vo(j1,m1)*weight
     &                              +anisox(m1,k1,j1,l1)*w(k1,l1)
     &                                 *vo(i1,m1)*weight
                                do n1=1,3
                                  s(iii1,jjj1)=s(iii1,jjj1)
     &                                  +anisox(m1,k1,n1,l1)
     &                                  *w(k1,l1)*vo(i1,m1)*vo(j1,n1)
     &                                  *weight
                                enddo
                              enddo
                            enddo
                          enddo
                        enddo
                      enddo
!SPEC: The immediately preceding loop nest is also available in 
!SPEC: program-generated (much longer) form from the author's 
!SPEC: website (see 454.calculix/Docs) in file anisonl.f
!SPEC:
!SPEC:                   call anisonl(w,vo,elas,s,ii1,jj1,weight)
!SPEC:
                     endif
!
!                   stress stiffness
!
                     senergy=
     &                    (s11*w(1,1)+s12*(w(1,2)+w(2,1))
     &                    +s13*(w(1,3)+w(3,1))+s22*w(2,2)
     &                    +s23*(w(2,3)+w(3,2))+s33*w(3,3))*weight
                     s(ii1,jj1)=s(ii1,jj1)+senergy
                     s(ii1+1,jj1+1)=s(ii1+1,jj1+1)+senergy
                     s(ii1+2,jj1+2)=s(ii1+2,jj1+2)+senergy
!
!                   mass matrix
!
                     if(mass) then
                        sm(ii1,jj1)=sm(ii1,jj1)
     &                       +rho*shpj(4,ii)*shp(4,jj)*weight
                        sm(ii1+1,jj1+1)=sm(ii1,jj1)
                        sm(ii1+2,jj1+2)=sm(ii1,jj1)
                     endif
!
!                    stiffness contribution of centrifugal forces
!
                     if(mass.and.(om.gt.0.d0)) then
                        dmass=shpj(4,ii)*shp(4,jj)*weight*om
                        do m1=1,3
                           s(ii1+m1-1,jj1+m1-1)=s(ii1+m1-1,jj1+m1-1)-
     &                          dmass
                           do m2=1,3
                              s(ii1+m1-1,jj1+m2-1)=s(ii1+m1-1,jj1+m2-1)+
     &                             dmass*p2(m1)*p2(m2)
                           enddo
                        enddo
                     endif
!
                     ii1=ii1+3
                  enddo
                  jj1=jj1+3
               enddo
            endif
!
         endif
!
!           computation of the right hand side
!
         if(rhs) then
!
!             body forces
!
            if(ibod.ne.0) then
               if(om.gt.0.d0) then
                  do i1=1,3
!
!                   computation of the global coordinates of the gauss
!                   point
!
                     q(i1)=0.d0
                     if(iperturb.eq.0) then
                        do j1=1,nope
                           q(i1)=q(i1)+shp(4,j1)*xl(i1,j1)
                        enddo
                     else
                        do j1=1,nope
                           q(i1)=q(i1)+shp(4,j1)*
     &                          (xl(i1,j1)+voldl(i1,j1))
                        enddo
                     endif
!                       
                     q(i1)=q(i1)-p1(i1)
                  enddo
                  const=q(1)*p2(1)+q(2)*p2(2)+q(3)*p2(3)
!
!                 inclusion of the centrifugal force into the body force
!
                  do i1=1,3
                     bf(i1)=bodyf(i1)+(q(i1)-const*p2(i1))*om
                  enddo
               else
                  do i1=1,3
                     bf(i1)=bodyf(i1)
                  enddo
               endif
               jj1=1
               do jj=1,nope
                  f(jj1)=f(jj1)+bf(1)*shpj(4,jj)*weight
                  f(jj1+1)=f(jj1+1)+bf(2)*shpj(4,jj)*weight
                  f(jj1+2)=f(jj1+2)+bf(3)*shpj(4,jj)*weight
                  ff(jj1)=ff(jj1)+bf(1)*shpj(4,jj)*weight
                  ff(jj1+1)=ff(jj1+1)+bf(2)*shpj(4,jj)*weight
                  ff(jj1+2)=ff(jj1+2)+bf(3)*shpj(4,jj)*weight
                  jj1=jj1+3
               enddo
            endif
!
!             thermal stresses and/or residual stresses
!
            if((ithermal.ne.0).or.(iprestr.ne.0)) then
               do jj=1,6
                  beta(jj)=beta(jj)*xsj
               enddo
               jj1=1
               do jj=1,nope
                  f(jj1)=f(jj1)+(shp(1,jj)*beta(1)+
     &                 (shp(2,jj)*beta(4)+shp(3,jj)*beta(5))/2.d0)
     &                 *weight
                  f(jj1+1)=f(jj1+1)+(shp(2,jj)*beta(2)+
     &                 (shp(1,jj)*beta(4)+shp(3,jj)*beta(6))/2.d0)
     &                 *weight
                  f(jj1+2)=f(jj1+2)+(shp(3,jj)*beta(3)+
     &                 (shp(1,jj)*beta(5)+shp(2,jj)*beta(6))/2.d0)
     &                 *weight
                  jj1=jj1+3
               enddo
            endif
!
         endif
!
      enddo
!
c      write(*,'(6(1x,e11.4))') ((s(i1,j1),i1=1,j1),j1=1,60)
c      write(*,*)
c
      if(.not.buckling) then
!
!       distributed loads
!
         if(nload.eq.0) then
            return
         endif
         call nident2(nelemload,nelem,nload,id)
         do
            if((id.eq.0).or.(nelemload(1,id).ne.nelem)) exit
            read(sideload(id)(2:2),'(i1)') ig
!
!         treatment of wedge faces
!
            if(lakonl(4:4).eq.'6') then
               mint2d=1
               if(ig.le.2) then
                  nopes=3
               else
                  nopes=4
               endif
            endif
          if(lakonl(4:5).eq.'15') then
             if(ig.le.2) then
                mint2d=3
                nopes=6
             else
                mint2d=4
                nopes=8
             endif
          endif
!
          if((nope.eq.20).or.(nope.eq.8)) then
             if(iperturb.eq.0) then
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifaceq(i,ig)))
                   enddo
                enddo
             else
                if(mass) then
                   do i=1,nopes
                      do j=1,3
                         xl1(j,i)=co(j,konl(ifaceq(i,ig)))
                      enddo
                   enddo
                endif
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifaceq(i,ig)))+
     &                     vold(j,konl(ifaceq(i,ig)))
                   enddo
                enddo
             endif
          elseif((nope.eq.10).or.(nope.eq.4)) then
             if(iperturb.eq.0) then
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifacet(i,ig)))
                   enddo
                enddo
             else
                if(mass) then
                   do i=1,nopes
                      do j=1,3
                         xl1(j,i)=co(j,konl(ifacet(i,ig)))
                      enddo
                   enddo
                endif
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifacet(i,ig)))+
     &                     vold(j,konl(ifacet(i,ig)))
                   enddo
                enddo
             endif
          else
             if(iperturb.eq.0) then
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifacew(i,ig)))
                   enddo
                enddo
             else
                if(mass) then
                   do i=1,nopes
                      do j=1,3
                         xl1(j,i)=co(j,konl(ifacew(i,ig)))
                      enddo
                   enddo
                endif
                do i=1,nopes
                   do j=1,3
                      xl2(j,i)=co(j,konl(ifacew(i,ig)))+
     &                     vold(j,konl(ifacew(i,ig)))
                   enddo
                enddo
             endif
          endif
!
          do i=1,mint2d
             if((lakonl(4:5).eq.'8R').or.
     &            ((lakonl(4:4).eq.'6').and.(nopes.eq.4))) then
                xi=gauss2d1(1,i)
                et=gauss2d1(2,i)
                weight=weight2d1(i)
             elseif((lakonl(4:4).eq.'8').or.
     &               (lakonl(4:6).eq.'20R').or.
     &               ((lakonl(4:5).eq.'15').and.(nopes.eq.8))) then
                xi=gauss2d2(1,i)
                et=gauss2d2(2,i)
                weight=weight2d2(i)
             elseif(lakonl(4:4).eq.'2') then
                xi=gauss2d3(1,i)
                et=gauss2d3(2,i)
                weight=weight2d3(i)
             elseif((lakonl(4:5).eq.'10').or.
     &               ((lakonl(4:5).eq.'15').and.(nopes.eq.6))) then
                xi=gauss2d5(1,i)
                et=gauss2d5(2,i)
                weight=weight2d5(i)
             elseif((lakonl(4:4).eq.'4').or.
     &               ((lakonl(4:4).eq.'6').and.(nopes.eq.3))) then
                xi=gauss2d4(1,i)
                et=gauss2d4(2,i)
                weight=weight2d4(i)
             endif
!
             if(rhs) then
                if(nopes.eq.8) then
                   call shape8q(xi,et,xl2,xsj2,shp2)
                elseif(nopes.eq.4) then
                   call shape4q(xi,et,xl2,xsj2,shp2)
                elseif(nopes.eq.6) then
                   call shape6tri(xi,et,xl2,xsj2,shp2)
                else
                   call shape3tri(xi,et,xl2,xsj2,shp2)
                endif
!
                do k=1,nopes
                   if((nope.eq.20).or.(nope.eq.8)) then
                      ipointer=(ifaceq(k,ig)-1)*3
                   elseif((nope.eq.10).or.(nope.eq.4)) then
                      ipointer=(ifacet(k,ig)-1)*3
                   else
                      ipointer=(ifacew(k,ig)-1)*3
                   endif
                   f(ipointer+1)=f(ipointer+1)-shp2(4,k)*xload(1,id)
     &                  *xsj2(1)*weight
                   f(ipointer+2)=f(ipointer+2)-shp2(4,k)*xload(1,id)
     &                  *xsj2(2)*weight
                   f(ipointer+3)=f(ipointer+3)-shp2(4,k)*xload(1,id)
     &                  *xsj2(3)*weight
                   ff(ipointer+1)=ff(ipointer+1)-shp2(4,k)*xload(1,id)
     &                  *xsj2(1)*weight
                   ff(ipointer+2)=ff(ipointer+2)-shp2(4,k)*xload(1,id)
     &                  *xsj2(2)*weight
                   ff(ipointer+3)=ff(ipointer+3)-shp2(4,k)*xload(1,id)
     &                  *xsj2(3)*weight
                enddo
!
!            stiffness contribution of the distributed load 
!
             elseif(mass) then
                if(nopes.eq.8) then
                   call shape8q(xi,et,xl1,xsj2,shp2)
                elseif(nopes.eq.4) then
                   call shape4q(xi,et,xl1,xsj2,shp2)
                elseif(nopes.eq.6) then
                   call shape6tri(xi,et,xl1,xsj2,shp2)
                else
                   call shape3tri(xi,et,xl1,xsj2,shp2)
                endif
!
!               calculation of the deformation gradient
!
                do k=1,3
                   do l=1,3
                      xkl(k,l)=0.d0
                      do ii=1,nopes
                         xkl(k,l)=xkl(k,l)+shp2(l,ii)*xl2(k,ii)
                      enddo
                   enddo
                enddo
!
                do ii=1,nopes
                   if((nope.eq.20).or.(nope.eq.8)) then
                      ipointeri=(ifaceq(ii,ig)-1)*3
                   elseif((nope.eq.10).or.(nope.eq.4)) then
                     ipointeri=(ifacet(ii,ig)-1)*3
                   else
                      ipointeri=(ifacew(ii,ig)-1)*3
                   endif
                   do jj=1,nopes
                      if((nope.eq.20).or.(nope.eq.8)) then
                         ipointerj=(ifaceq(jj,ig)-1)*3
                      elseif((nope.eq.10).or.(nope.eq.4)) then
                         ipointerj=(ifacet(jj,ig)-1)*3
                      else
                         ipointerj=(ifacew(jj,ig)-1)*3
                      endif
                      do k=1,3
                         do l=1,3
                            if(k.eq.l) cycle
                            if(k*l.eq.2) then
                               n=3
                            elseif(k*l.eq.3) then
                               n=2
                            else
                               n=1
                            endif
                            term=weight*xload(1,id)*shp2(4,jj)*
     &                       (xsj2(1)*
     &                        (xkl(n,2)*shp2(3,ii)-xkl(n,3)*shp2(2,ii))+
     &                        xsj2(2)*
     &                        (xkl(n,3)*shp2(1,ii)-xkl(n,1)*shp2(3,ii))+
     &                        xsj2(3)*
     &                        (xkl(n,1)*shp2(2,ii)-xkl(n,2)*shp2(1,ii)))
                            if(ipointeri+k.le.ipointerj+l) then
                               s(ipointeri+k,ipointerj+l)=
     &                              s(ipointeri+k,ipointerj+l)+term/2.d0
                            else
                               s(ipointerj+l,ipointeri+k)=
     &                              s(ipointerj+l,ipointeri+k)+term/2.d0
                            endif
                         enddo
                      enddo
                   enddo
                enddo
!
             endif
          enddo
!
          id=id-1
       enddo
!
      elseif(mass.and.(iexpl.eq.1)) then
!
!        scaling the diagonal terms of the mass matrix such that the total mass
!        is right (LUMPING; for explicit dynamic calculations)
!
         sume=0.d0
         summ=0.d0
         do i=1,3*nopev,3
            sume=sume+sm(i,i)
         enddo
         do i=3*nopev+1,3*nope,3
            summ=summ+sm(i,i)
         enddo
!
         if(nope.eq.20) then
c            alp=.2215d0
            alp=.2917d0
!              maybe alp=.2917d0 is better??
         elseif(nope.eq.10) then
            alp=0.1203d0
         elseif(nope.eq.15) then
            alp=0.2141d0
         endif
!
         if((nope.eq.20).or.(nope.eq.10).or.(nope.eq.15)) then
            factore=summass*alp/(1.d0+alp)/sume
            factorm=summass/(1.d0+alp)/summ
         else
            factore=summass/sume
         endif
!
         do i=1,3*nopev,3
            sm(i,i)=sm(i,i)*factore
            sm(i+1,i+1)=sm(i,i)
            sm(i+2,i+2)=sm(i,i)
         enddo
         do i=3*nopev+1,3*nope,3
            sm(i,i)=sm(i,i)*factorm
            sm(i+1,i+1)=sm(i,i)
            sm(i+2,i+2)=sm(i,i)
         enddo
!
      endif
!
      return
      end

invivoe_c3d_e_c3d__247

Real time: 2.858368e+06 -- Predicted time: 3.355124e+06

Callcount: 32

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	1.234240e+05	1.217520e+05	1.3
21	### 2	31.1123268934861	1.038720e+05	9.358400e+04	9.9

                /*     CalculiX - A 3-dimensional finite element program                 */
/*              Copyright (C) 1998 Guido Dhondt                          */

/*     This program is free software; you can redistribute it and/or     */
/*     modify it under the terms of the GNU General Public License as    */
/*     published by the Free Software Foundation(version 2);    */
/*                                                                       */

/*     This program is distributed in the hope that it will be useful,   */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of    */ 
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the      */
/*     GNU General Public License for more details.                      */

/*     You should have received a copy of the GNU General Public License */
/*     along with this program; if not, write to the Free Software       */
/*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.         */

#include <stdlib.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "CalculiX.h"

int main(int argc,char *argv[])
{
  int *kon=NULL, *nodeboun=NULL, *ndirboun=NULL, *ipompc=NULL,
    *nodempc=NULL, *nodeforc=NULL, *ndirforc=NULL,
    *nelemload=NULL, *nodeprint=NULL, *nelemprint=NULL,
    *nnn=NULL, *nactdof=NULL, *icol=NULL,*ics=NULL,
    *jq=NULL, *mast1=NULL, *irow=NULL, *rig=NULL,
    *ikmpc=NULL, *ilmpc=NULL, *ikboun=NULL, *ilboun=NULL,
    *npn=NULL, *adj=NULL, *xadj=NULL, *iw=NULL, *nreorder=NULL,
    *mmm=NULL, *xnpn=NULL, *ikcol=NULL, *ipointer=NULL,
    *istartset=NULL, *iendset=NULL, *ialset=NULL, *ielmat=NULL,
    *ielorien=NULL, *nrhcon=NULL, *nodebounold=NULL, *ndirbounold=NULL,
    *nelcon=NULL, *nalcon=NULL, *iamforc=NULL,  *iamload=NULL,
    *iamt1=NULL, *namta=NULL, *ipkon=NULL, *iamboun=NULL,
    *nplicon=NULL, *nplkcon=NULL, *inotr=NULL, *iponor=NULL, *knor=NULL,
    *ikforc=NULL, *ilforc=NULL, *iponoel=NULL, *inoel=NULL, *nshcon=NULL,
    *ncocon=NULL,  *nodeflow=NULL,*iamflow=NULL;

double *co=NULL, *xboun=NULL, *coefmpc=NULL, *xforc=NULL,
      *xload=NULL, *ad=NULL, *au=NULL, *xbounold=NULL, *xforcold=NULL,
      *b=NULL, *vold=NULL, *sti=NULL, *xloadold=NULL, *xnor=NULL,
      *reorder=NULL,*dcs=NULL, *thickn=NULL, *thicke=NULL, *offset=NULL,
      *elcon=NULL, *rhcon=NULL, *alcon=NULL, *alzero=NULL, *t0=NULL, *t1=NULL,
      *prestr=NULL, *orab=NULL, *amta=NULL, *veold=NULL, *accold=NULL,
      *adb=NULL, *aub=NULL, *t1old=NULL, *eei=NULL, *plicon=NULL, *plkcon=NULL,
      *xstate=NULL, *trab=NULL, *ener=NULL, *shcon=NULL, *cocon=NULL,
      *xflow=NULL,*xflowold=NULL;

 double ctrl[26]={4.5,8.5,9.5,16.5,10.5,4.5,0.,5.5,0.,0.,0.25,0.5,0.75,0.,0.,0.,1.5,0.,0.005,0.01,0.,0.,0.02,1.e-5,1.e-3,1.e-8};

char *sideload=NULL, *set=NULL, *matname=NULL, *orname=NULL, *amname=NULL,
      *noelplab=NULL, *nodeflab=NULL, *lakon=NULL, *labmpc=NULL, 
      jobnamec[132]="",jobnamef[132]="",output[3]="frd";

int sideloadLen=5, setLen=21, matnameLen=20, ornameLen=20, amnameLen=20, noelplabLen=4, 
    nodeflabLen=4, lakonLen=8, labmpcLen=20, jobnamecLen=132, jobnamefLen=132, outputLen=3;

int nk,ne,nboun,nmpc,nforc,nload,noprint,neprint,nset,nalset,nsky,
  nmethod,neq=0,i,mpcfree=1,nev,j,nzl,nam,nbounold=0,nforcold=0,nloadold=0,
  k,nzs,nmpc_=0,nload_=0,nforc_=0,istep,istat,nboun_=0,nflowold=0,
  iperturb=0,nmat,ntmat_=0,norien,ithermal,iprestr,in,kode,isolver=0,
  mxiter,ncv,iamom,iambodyf,jout,nlabel,nkon=0,idrct,jmax,iexpl,
  iplas=0,npmat_=0,mint_=0,ntrans,mpcend,namtot_=0,ns[5],iumat=0,mpcmult,
  icascade,maxlenmpc,mpcinfo[4],ne1d=0,ne2d=0,infree[4]={0,0,0,0},
  callfrommain,nflow,nflow_=0,jin=0;

int itread,*meminset=NULL,*rmeminset=NULL;

int nzs_,nk_=0,ne_=0,nset_=0,nalset_=0,nmat_=0,norien_=0,nam_=0,noprint_=0,
    neprint_=0,ntrans_=0,ncs_=0,nstate_=0,ncmat_=0,memmpc_=0;

double p1[3],p2[3],bodyf[3],om,omold,tol,bodyfold[3],
  tinc,tper,tmin,tmax,alpham=0.,betam=0.,alpha,haftol,ttime=0.,
  qaold=0.,csab[7],physcon[2];

#ifdef SPEC_CPU
FILE *fpfor_ztest;
int  intfor_ztest;
#endif

if(argc==1){printf("Usage: CalculiX.exe -i jobname\n");FORTRAN(stop,());}
else{
  for(i=1;i<argc;i++){
    if(strcmp1(argv[i],"-i")==0) {
    strcpy(jobnamec,argv[i+1]);strcpy1(jobnamef,argv[i+1],132);jin++;break;}
  }
  if(jin==0){strcpy(jobnamec,argv[1]);strcpy1(jobnamef,argv[1],132);}

  for(i=1;i<argc;i++){
    if(strcmp1(argv[i],"-o")==0) {
    strcpy(output,argv[i+1]);break;}
  }
}

#ifdef SPEC_CPU
/* Test whether the portability switch -DSPEC_CPU_NOZMODIFIER needs */
/* to be set.  SPEC has modified CalculiX and SPOOLES to use %zd        */
/* when printing pointers; but not all compilers support this.  So, for */
/* those compilers a portability switch is provided.  Find out whether  */
/* that switch should be used today.  --jh 17 Feb 2005                  */

intfor_ztest = 3;
fpfor_ztest = fopen ("SPECtestformatmodifier_z.txt","w");
fprintf (fpfor_ztest, "The following line should contain a single '3':\n");

#ifdef SPEC_CPU_NOZMODIFIER
fprintf (fpfor_ztest, "%d\n", (size_t) intfor_ztest);
#else
fprintf (fpfor_ztest, "%zd\n", (size_t) intfor_ztest);
#endif /* SPEC_CPU_NOZMODIFIER */

fprintf (fpfor_ztest, "If it said anything else (such as 'zd') try compiling\n");
fprintf (fpfor_ztest, "with -DSPEC_CPU_NOZMODIFIER\n");
fclose(fpfor_ztest);
#endif /* SPEC_CPU */ 

#if defined(SPEC_CPU_NAGF95)
FORTRAN(openfile,(jobnamef,output,132,3));
#else
FORTRAN(openfile,(jobnamef,output));
#endif


printf("\n************************************************************\n\n");
printf("CalculiX DEVELOPMENT VERSION, Copyright(C) 1998 Guido Dhondt\n");
printf("CalculiX comes with ABSOLUTELY NO WARRANTY. This is free\n");
printf("software, and you are welcome to redistribute it under\n");
printf("certain conditions, see gpl.htm\n\n");
printf("************************************************************\n\n");

istep=0;
istat=0;
ithermal=0;
iprestr=0;
in=1;
kode=0;
ns[0]=0;
ns[4]=1;

/* conservative estimate of the fields to be allocated */

for(itread=0;itread<2;itread++){

#if defined(SPEC_CPU_NAGF95)
  FORTRAN(allocation,(&nload_,&nforc_,&nboun_,&nk_,&ne_,&nmpc_,&nset_,&nalset_,
   &nmat_,&ntmat_,&npmat_,&norien_,&nam_,&noprint_,&neprint_,&mint_,&ntrans_,
   &in,&itread,set,meminset,rmeminset,&ncs_,&namtot_,&ncmat_,&memmpc_,&ne1d,
   &ne2d,&nflow_, setLen));
#else
  FORTRAN(allocation,(&nload_,&nforc_,&nboun_,&nk_,&ne_,&nmpc_,&nset_,&nalset_,
   &nmat_,&ntmat_,&npmat_,&norien_,&nam_,&noprint_,&neprint_,&mint_,&ntrans_,
   &in,&itread,set,meminset,rmeminset,&ncs_,&namtot_,&ncmat_,&memmpc_,&ne1d,
   &ne2d,&nflow_));
#endif

  if(itread==0){
    setLen = 21*nset_; // added by yusuf
    set=NNEW(char,21*nset_);
    meminset=NNEW(int,nset_);
    rmeminset=NNEW(int,nset_);}
  else{free(set);free(meminset);free(rmeminset);}
}

nzs_=20000000;

nload=0;nforc=0;nboun=0;nk=0;nmpc=0;nflow=0;
nlabel=8;

for(k=0;k<3;++k){
  p1[k]=0.;
  p2[k]=0.;
  bodyf[k]=0.;
}
om=0.;
iamom=0;
iambodyf=0;

while(istat>=0) {

  /* in order to reduce the number of variables to be transferred to
     the subroutines, the max. field sizes are (for most fields) copied
     into the real sizes */

  nzs=nzs_;
  noprint=noprint_;
  neprint=neprint_;

  if(istep == 0) {
    ne=ne_;
    nset=nset_;
    nalset=nalset_;
    nmat=nmat_;
    norien=norien_;
    ntrans=ntrans_;
    nam=nam_;

    /* allocating space before the first step */

    /* coordinates and topology */

    co=NNEW(double,3*nk_);
    kon=NNEW(int,20*ne_);
    ipkon=NNEW(int,ne_);
    lakonLen = 8*ne_; // added by yusuf
    lakon=NNEW(char,8*ne_);

    /* fields for 1-D and 2-D elements */

    if((ne1d!=0)||(ne2d!=0)){
	iponor=NNEW(int,40*ne_);
	for(i=0;i<40*ne_;i++) iponor[i]=-1;
	xnor=NNEW(double,36*ne1d+24*ne2d);
	knor=NNEW(int,24*(ne1d+ne2d));
	thickn=NNEW(double,2*nk_);
	thicke=NNEW(double,40*ne_);
	offset=NNEW(double,2*ne_);
	iponoel=NNEW(int,nk_);
	inoel=NNEW(int,9*ne1d+24*ne2d);
	rig=NNEW(int,nk_);
	infree[2]=1;
    }

    /* SPC's */

    nodeboun=NNEW(int,nboun_);
    ndirboun=NNEW(int,nboun_);
    iamboun=NNEW(int,nboun_);
    xboun=NNEW(double,nboun_);
    ikboun=NNEW(int,nboun_);
    ilboun=NNEW(int,nboun_);

    /* MPC's */

    ipompc=NNEW(int,nmpc_);
    nodempc=NNEW(int,3*memmpc_);
    for(i=0;i<3*memmpc_;i+=3){nodempc[i+2]=i/3+2;}
    nodempc[3*memmpc_-1]=0;
    coefmpc=NNEW(double,memmpc_);
    labmpcLen = 20*nmpc_; // added by yusuf
    labmpc=NNEW(char,20*nmpc_);
    ikmpc=NNEW(int,nmpc_);
    ilmpc=NNEW(int,nmpc_);


    /* nodal loads */

    nodeforc=NNEW(int,nforc_);
    ndirforc=NNEW(int,nforc_);
    iamforc=NNEW(int,nforc_);
    xforc=NNEW(double,nforc_);
    ikforc=NNEW(int,nforc_);
    ilforc=NNEW(int,nforc_);

    /* distributed loads */

    nelemload=NNEW(int,2*nload_);
    iamload=NNEW(int,2*nload_);
    sideloadLen = 5*nload_; // added by yusuf
    sideload=NNEW(char,5*nload_);
    xload=NNEW(double,2*nload_);

    /* mass flow rate */

    nodeflow=NNEW(int,2*nflow_);
    iamflow=NNEW(int,nflow_);
    xflow=NNEW(double,nflow_);

    /* printing output */

    nodeprint=NNEW(int,noprint);
    nelemprint=NNEW(int,neprint);

    /* set definitions */

    setLen = 21*nset; // added by yusuf
    set=NNEW(char,21*nset);
    istartset=NNEW(int,nset);
    iendset=NNEW(int,nset);
    ialset=NNEW(int,nalset);

    /* (hyper)elastic constants */

    elcon=NNEW(double,(ncmat_+1)*ntmat_*nmat);
    nelcon=NNEW(int,2*nmat);

    /* density */

    rhcon=NNEW(double,2*ntmat_*nmat);
    nrhcon=NNEW(int,nmat);

    /* specific heat */

    shcon=NNEW(double,2*ntmat_*nmat);
    nshcon=NNEW(int,nmat);

    /* thermal expansion coefficients */

    alcon=NNEW(double,7*ntmat_*nmat);
    nalcon=NNEW(int,2*nmat);
    alzero=NNEW(double,nmat);

    /* conductivity */

    cocon=NNEW(double,7*ntmat_*nmat);
    ncocon=NNEW(int,2*nmat);

    /* isotropic and kinematic hardening coefficients*/

    plicon=NNEW(double,(2*npmat_+1)*ntmat_*nmat);
    nplicon=NNEW(int,(ntmat_+1)*nmat);
    plkcon=NNEW(double,(2*npmat_+1)*ntmat_*nmat);
    nplkcon=NNEW(int,(ntmat_+1)*nmat);

    /* material orientation */

    ornameLen = 20*norien; // added by yusuf
    orname=NNEW(char,20*norien);
    orab=NNEW(double,7*norien);
    ielorien=NNEW(int,ne_);

    /* transformations */

    trab=NNEW(double,7*ntrans);
    inotr=NNEW(int,2*nk_);

    /* amplitude definitions */

    amnameLen = 20*nam; // added by yusuf
    amname=NNEW(char,20*nam);
    amta=NNEW(double,2*namtot_);
    namta=NNEW(int,3*nam);

    /* temperatures */

    if((ne1d==0)&&(ne2d==0)){
	t0=NNEW(double,nk_);
	t1=NNEW(double,nk_);}
    else{
	t0=NNEW(double,3*nk_);
	t1=NNEW(double,3*nk_);}
    iamt1=NNEW(int,nk_);

    prestr=NNEW(double,6*ne_);
    veold=NNEW(double,4*nk_);

    ielmat=NNEW(int,ne_);

    matnameLen = 20*nmat; // added by yusuf
    matname=NNEW(char,20*nmat);

    noelplabLen = 4*nlabel; // added by yusuf
    noelplab=NNEW(char,4*nlabel);
    nodeflabLen = 4*nlabel; // added by yusuf
    nodeflab=NNEW(char,4*nlabel);

    /* temporary fields for cyclic symmetry calculations */

    if(ncs_>0){
      ics=NNEW(int,3*ncs_);
      dcs=NNEW(double,4*ncs_);
    }

  }
  else {

    /* allocating and reallocating space for subsequent steps */

    if((nmethod != 4) && ((nmethod != 1) || (iperturb < 2))){
      veold=NNEW(double,4*nk_);
    }
    else{
      RENEW(veold,double,4*nk_);
    }

    if(nmethod != 4){free(accold);}

    RENEW(nodeboun,int,nboun_);
    RENEW(ndirboun,int,nboun_);
    RENEW(xboun,double,nboun_);
    RENEW(ikboun,int,nboun_);
    RENEW(ilboun,int,nboun_);

    RENEW(nodeforc,int,nforc_);
    RENEW(ndirforc,int,nforc_);
    RENEW(xforc,double,nforc_);
    RENEW(ikforc,int,nforc_);
    RENEW(ilforc,int,nforc_);

    RENEW(nelemload,int,2*nload_);
    sideloadLen = 5*nload_; // added by yusuf
    RENEW(sideload,char,5*nload_);
    RENEW(xload,double,2*nload_);

    RENEW(nodeflow,int,2*nflow_);
    RENEW(xflow,double,nflow_);

    RENEW(nodeprint,int,noprint);
    RENEW(nelemprint,int,neprint);

    if(nam > 0) {
      RENEW(iamforc,int,nforc_);
      RENEW(iamload,int,2*nload_);
      RENEW(iamboun,int,nboun_);
      RENEW(iamflow,int,nflow_);
    }

    RENEW(ipompc,int,nmpc_);
/*    RENEW(nodempc,int,3*memmpc_);
    for(i=3*mpcend;i<3*memmpc_;i+=3){nodempc[i+2]=i/3+2;}
    nodempc[3*memmpc_-1]=0;
    RENEW(coefmpc,double,memmpc_);*/
    labmpcLen = 20*nmpc_; // added by yusuf
    RENEW(labmpc,char,20*nmpc_);
    RENEW(ikmpc,int,nmpc_);
    RENEW(ilmpc,int,nmpc_);

    if(ntrans > 0){
      RENEW(inotr,int,2*nk_);
    }

    RENEW(co,double,3*nk_);

    if(ithermal != 0){
	if((ne1d==0)&&(ne2d==0)){
	    RENEW(t0,double,nk_);
	    RENEW(t1,double,nk_);
	}
      if(nam > 0) {RENEW(iamt1,int,nk_);}
    }

  }

  /* reading the input file */

#if defined(SPEC_CPU_NAGF95)
  FORTRAN(calinput,(co,&nk,kon,ipkon,lakon,&nkon,&ne,
            nodeboun,ndirboun,xboun,&nboun,
	    ipompc,nodempc,coefmpc,&nmpc,&nmpc_,nodeforc,ndirforc,xforc,&nforc,
	    &nforc_,nelemload,sideload,xload,&nload,&nload_,p1,p2,&om,bodyf,
	    nodeprint,&noprint,nelemprint,&neprint,&mpcfree,&nboun_,
	    &nev,set,istartset,iendset,
	    ialset,&nset,&nalset,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
	    alzero,t0,t1,matname,ielmat,orname,orab,ielorien,amname,
            amta,namta,&nam,&nmethod,iamforc,iamload,&iamom,&iambodyf,iamt1,
	    &ithermal,&iperturb,&istat,&istep,&nmat,&ntmat_,&norien,prestr,
	    &iprestr,&in,&isolver,&tol,&ncv,&mxiter,veold,&tinc,&tper,
	    &alpham,&betam,noelplab,nodeflab,&jout,&nlabel,&idrct,
	    &jmax,&tmin,&tmax,&iexpl,&alpha,&haftol,iamboun,plicon,nplicon,
	    plkcon,nplkcon,&iplas,&npmat_,&mint_,&nk_,trab,inotr,&ntrans,
	    ikboun,ilboun,ikmpc,ilmpc,ics,dcs,&ncs_,&namtot_,ns,&nstate_,
	    &ncmat_,&iumat,csab,labmpc,iponor,xnor,knor,thickn,thicke,
	    ikforc,ilforc,offset,iponoel,inoel,rig,infree,nshcon,shcon,
            cocon,ncocon,physcon,&nflow,nodeflow,xflow,iamflow,&nflow_,
            ctrl, lakonLen, sideloadLen, setLen, matnameLen, ornameLen, 
            amnameLen, noelplabLen, nodeflabLen, labmpcLen));
#else
  FORTRAN(calinput,(co,&nk,kon,ipkon,lakon,&nkon,&ne,
            nodeboun,ndirboun,xboun,&nboun,
	    ipompc,nodempc,coefmpc,&nmpc,&nmpc_,nodeforc,ndirforc,xforc,&nforc,
	    &nforc_,nelemload,sideload,xload,&nload,&nload_,p1,p2,&om,bodyf,
	    nodeprint,&noprint,nelemprint,&neprint,&mpcfree,&nboun_,
	    &nev,set,istartset,iendset,
	    ialset,&nset,&nalset,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
	    alzero,t0,t1,matname,ielmat,orname,orab,ielorien,amname,
            amta,namta,&nam,&nmethod,iamforc,iamload,&iamom,&iambodyf,iamt1,
	    &ithermal,&iperturb,&istat,&istep,&nmat,&ntmat_,&norien,prestr,
	    &iprestr,&in,&isolver,&tol,&ncv,&mxiter,veold,&tinc,&tper,
	    &alpham,&betam,noelplab,nodeflab,&jout,&nlabel,&idrct,
	    &jmax,&tmin,&tmax,&iexpl,&alpha,&haftol,iamboun,plicon,nplicon,
	    plkcon,nplkcon,&iplas,&npmat_,&mint_,&nk_,trab,inotr,&ntrans,
	    ikboun,ilboun,ikmpc,ilmpc,ics,dcs,&ncs_,&namtot_,ns,&nstate_,
	    &ncmat_,&iumat,csab,labmpc,iponor,xnor,knor,thickn,thicke,
	    ikforc,ilforc,offset,iponoel,inoel,rig,infree,nshcon,shcon,
            cocon,ncocon,physcon,&nflow,nodeflow,xflow,iamflow,&nflow_,
            ctrl));
#endif

  if(istep == 1) {

    /* reallocating space in the first step */

    /* allocating and initializing fields pointing to the previous step */

    vold=NNEW(double,4*nk);
    sti=NNEW(double,6*mint_*ne);

    /* residual stresses */

    if(iprestr > 0) {
	RENEW(prestr,double,6*ne);
	for(i=0;i<ne;i++){
	    for(j=0;j<mint_;j++){
		for(k=0;k<6;k++){
		    sti[6*mint_*i+6*j+k]=prestr[6*i+k];
		}
	    }
	}
    }
    else {
	free(prestr);
    }

    if((strcmp1(&nodeflab[24],"ENER")==0)||(strcmp1(&noelplab[24],"ENER")==0))
	ener=NNEW(double,mint_*ne);

    nodebounold=NNEW(int,nboun);
    ndirbounold=NNEW(int,nboun);
    xbounold=NNEW(double,nboun);
    xforcold=NNEW(double,nforc);
    xloadold=NNEW(double,2*nload);
    if(ithermal>1) xflowold=NNEW(double,nflow);
    for(i=0;i<3;i++) bodyfold[i]=0;
    omold=0;
    if(ithermal==1){
      t1old=NNEW(double,nk);
      for(i=0;i<nk;i++) t1old[i]=t0[i];
    }

    /* strains */

    eei=NNEW(double,6*mint_*ne);

    /* element definition */

    RENEW(kon,int,nkon);
    RENEW(ipkon,int,ne);
    lakonLen = 8*ne; // added by yusuf
    RENEW(lakon,char,8*ne);

    /* fields for 1-D and 2-D elements */

    if((ne1d!=0)||(ne2d!=0)){
	RENEW(iponor,int,2*nkon);
	RENEW(xnor,double,infree[0]-1);
	RENEW(knor,int,infree[1]-1);
	free(thickn);
	RENEW(thicke,double,2*nkon);
	RENEW(offset,double,2*ne);
	RENEW(inoel,int,3*(infree[2]-1));
	RENEW(iponoel,int,infree[3]);
	RENEW(rig,int,infree[3]);
    }

    /* set definitions */ 

    setLen = 21*nset; // added by yusuf
    RENEW(set,char,21*nset);
    RENEW(istartset,int,nset);
    RENEW(iendset,int,nset);
    RENEW(ialset,int,nalset);

    /* material properties */

    RENEW(elcon,double,(ncmat_+1)*ntmat_*nmat);
    RENEW(nelcon,int,2*nmat);

    RENEW(rhcon,double,2*ntmat_*nmat);
    RENEW(nrhcon,int,nmat);

    RENEW(alcon,double,7*ntmat_*nmat);
    RENEW(nalcon,int,2*nmat);
    RENEW(alzero,double,nmat);

    matnameLen = 20*nmat; // added by yusuf
    RENEW(matname,char,20*nmat);
    RENEW(ielmat,int,ne);

    /* allocating space for the state variables */

    if(nstate_>0){
      xstate=NNEW(double,nstate_*mint_*ne);
    }

    if(iplas!=0){
      RENEW(plicon,double,(2*npmat_+1)*ntmat_*nmat);
      RENEW(nplicon,int,(ntmat_+1)*nmat);
      RENEW(plkcon,double,(2*npmat_+1)*ntmat_*nmat);
      RENEW(nplkcon,int,(ntmat_+1)*nmat);

      /* initializing the plastic state variables */

      for(i=0;i<ne;i++){
	if(nelcon[ielmat[i]*2-2]<-50){
	  for(j=0;j<mint_;j++){
	    xstate[13*mint_*i+13*j]=0;
	    for(k=1;k<4;k++){
	      xstate[13*mint_*i+13*j+k]=1;
	    }
	    for(k=4;k<13;k++){
	      xstate[13*mint_*i+13*j+k]=0;
	    }
	  }
	}
      }
    }
    else{
      free(plicon);free(nplicon);free(plkcon);free(nplkcon);
    }

    /* material orientation */

    if(norien > 0) {
      ornameLen = 20*norien; // added by yusuf
      RENEW(orname,char,20*norien);
      RENEW(ielorien,int,ne);
      RENEW(orab,double,7*norien);
    }
    else {
      free(orname);
      free(ielorien);
      free(orab);
    }

    /* amplitude definitions */

    if(nam > 0) {
      amnameLen = 20*nam; // added by yusuf
      RENEW(amname,char,20*nam);
      RENEW(namta,int,3*nam);
      RENEW(amta,double,2*namta[3*nam-2]);
    }
    else {
      free(amname);
      free(amta);
      free(namta);
      free(iamforc);
      free(iamload);
      free(iamboun);
    }

    if(ntrans > 0){
      RENEW(trab,double,7*ntrans);
    }
    else{free(trab);free(inotr);}

    if(ithermal == 0){free(t0);free(t1);}
    if((ithermal == 0)||(nam<=0)){free(iamt1);}

    if(ncs_>0){
      RENEW(ics,int,ncs_);
      free(dcs);}

  }
  else{

    /* reallocating space in all but the first step (>1) */

    RENEW(vold,double,4*nk);

    /* if the SPC boundary conditions were changed in the present step,
       they have to be rematched with those in the last step. Removed SPC 
       boundary conditions do not appear any more (this is different from
       forces and loads, where removed forces or loads are reset to zero;
       a removed SPC constraint does not have a numerical value any more) */
       
    reorder=NNEW(double,nboun);
    nreorder=NNEW(int,nboun);
    if(nbounold<nboun){
      RENEW(xbounold,double,nboun);
      RENEW(nodebounold,int,nboun);
      RENEW(ndirbounold,int,nboun);
    }
    FORTRAN(spcmatch,(xboun,nodeboun,ndirboun,&nboun,xbounold,nodebounold,
	      ndirbounold,&nbounold,ikboun,ilboun,vold,reorder,nreorder));
    RENEW(xbounold,double,nboun);
    RENEW(nodebounold,int,nboun);
    RENEW(ndirbounold,int,nboun);
    free(reorder); free(nreorder);

    /* for additional forces or loads in the present step, the
       corresponding slots in the force and load fields of the
       previous steps are initialized */

    RENEW(xforcold,double,nforc);
    for(i=nforcold;i<nforc;i++) xforcold[i]=0;

    RENEW(xloadold,double,2*nload);
    for(i=2*nloadold;i<2*nload;i++) xloadold[i]=0;

    if(ithermal>1){
	RENEW(xflowold,double,nflow);
	for(i=nflowold;i<nflow;i++) xflowold[i]=0;}

    if(ithermal==1){
      RENEW(t1old,double,nk);
    }
    
  }

  /* reallocating fields for all steps (>=1) */

  RENEW(co,double,3*nk);

  RENEW(nodeboun,int,nboun);
  RENEW(ndirboun,int,nboun);
  RENEW(xboun,double,nboun);
  RENEW(ikboun,int,nboun);
  RENEW(ilboun,int,nboun);
    
  RENEW(nodeforc,int,nforc);
  RENEW(ndirforc,int,nforc);
  RENEW(xforc,double,nforc);
  RENEW(ikforc,int,nforc);
  RENEW(ilforc,int,nforc);

  RENEW(nelemload,int,2*nload);
  sideloadLen = 5*nload_; // added by yusuf
  RENEW(sideload,char,5*nload);
  RENEW(xload,double,2*nload);

  RENEW(nodeprint,int,noprint);
  RENEW(nelemprint,int,neprint);

  RENEW(ipompc,int,nmpc);

  /* initial velocities and accelerations */

  if((nmethod == 4) || ((nmethod == 1) && (iperturb >= 2))) {
    RENEW(veold,double,4*nk);
  }
  else {free(veold);}

  if(nmethod == 4) {
    accold=NNEW(double,4*nk);
  }

  if(nam > 0) {
    RENEW(iamforc,int,nforc);
    RENEW(iamload,int,2*nload);
    RENEW(iamboun,int,nboun);
  }

  /* temperature loading */
  
  if(ithermal == 1){
      if((ne1d==0)&&(ne2d==0)){
	  RENEW(t0,double,nk);
	  RENEW(t1,double,nk);
      }
    if(nam > 0) {RENEW(iamt1,int,nk);}
  }

  if(ntrans > 0){
    RENEW(inotr,int,2*nk);
  }

  /* decascading MPC's and renumbering the equations: only necessary
  if MPC's changed */

  if((istep == 1)||(ntrans>0)) {

    /* decascading the MPC's */

    printf("Decascading the MPC's\n\n");

    callfrommain=1;
    cascade(ipompc,&coefmpc,&nodempc,&nmpc,
	    &mpcfree,nodeboun,ndirboun,&nboun,ikmpc,
	    ilmpc,ikboun,ilboun,&mpcend,&mpcmult,
	    labmpc,labmpcLen, &nk,&memmpc_,&icascade,&maxlenmpc,&callfrommain);

    /* reallocating nodempc and coefmpc */
 
    /* RENEW(nodempc,int,3*mpcend);
       RENEW(coefmpc,double,mpcend);*/
    labmpcLen = 20*nmpc; // added by yusuf
    RENEW(labmpc,char,20*nmpc);
    RENEW(ikmpc,int,nmpc);
    RENEW(ilmpc,int,nmpc);

    if(istep==1) nnn=NNEW(int,nk);
    else RENEW(nnn,int,nk);
    for(i=1;i<=nk;++i)
	nnn[i-1]=i;
	
    if(icascade==0){

	/* renumbering the nodes */
	
	printf("Renumbering the nodes to decrease the profile:\n");
	
	npn=NNEW(int,20*ne+mpcend);
	adj=NNEW(int,380*ne+mpcmult);
	xadj=NNEW(int,nk+1);
	iw=NNEW(int,3*nk+1);
	mmm=NNEW(int,nk);
	xnpn=NNEW(int,ne+nmpc+1);
	
#if defined(SPEC_CPU_NAGF95)
	FORTRAN(renumber,(&nk,kon,ipkon,lakon,&ne,ipompc,nodempc,&nmpc,nnn,
			  npn,adj,xadj,iw,mmm,xnpn, lakonLen));
#else
	FORTRAN(renumber,(&nk,kon,ipkon,lakon,&ne,ipompc,nodempc,&nmpc,nnn,
			  npn,adj,xadj,iw,mmm,xnpn));
#endif
	
	free(npn);free(adj);free(xadj);free(iw);free(mmm);free(xnpn);
    }
  }

  /* determining the matrix structure: changes if SPC's have changed */
  
  if(icascade==0) printf("Determining the structure of the matrix:\n");
  
  nactdof=NNEW(int,4*nk);
  
  if(isolver!=1) {
      mast1=NNEW(int,nzs);
      irow=NNEW(int,nzs);
  }
  
  if(ns[1]==-1){
      
      icol=NNEW(int,4*nk);
      jq=NNEW(int,4*nk+1);
      ikcol=NNEW(int,4*nk);
      ipointer=NNEW(int,4*nk);
      
      if(icascade==0){
	  mastruct(&nk,kon,ipkon,lakon,&ne,nodeboun,ndirboun,&nboun,ipompc,
		   nodempc,&nmpc,nactdof,icol,jq,&mast1,&irow,&isolver,&neq,nnn,
		   ikmpc,ilmpc,ikcol,ipointer,&nsky,&nzs,&nmethod,&ithermal);
      }
      else{neq=1;}
  }
  else{
      
      icol=NNEW(int,8*nk);
      jq=NNEW(int,8*nk+1);
      ikcol=NNEW(int,8*nk);
      ipointer=NNEW(int,8*nk);
      
      mastructcs(&nk,kon,ipkon,lakon,lakonLen, &ne,nodeboun,ndirboun,&nboun,
		 ipompc,nodempc,&nmpc,nactdof,icol,jq,&mast1,&irow,&isolver,
		 &neq,nnn,ikmpc,ilmpc,ikcol,ipointer,&nsky,&nzs,&nmethod,
		 ics,ns,labmpc, labmpcLen);}
  
  free(ikcol);free(ipointer);
  
  if(isolver!=1) {
      free(mast1);
      RENEW(irow,int,nzs);
  }

  /* nmethod=1: static analysis   */
  /* nmethod=2: frequency analysis  */
  /* nmethod=3: buckling analysis */
  /* nmethod=4: linear dynamic analysis */

  if((nmethod<=1)||(iperturb>1))
    {
      if(isolver==1){

	profile(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,nodempc,coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,icol,jq,&neq,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
             alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,&nsky,noelplab,noelplabLen,nodeflab,nodeflabLen,eei,&iexpl,
	     plicon,nplicon,plkcon,
             nplkcon,xstate,&npmat_,matname,matnameLen,&mint_,&ncmat_,&nstate_,ns,csab,
	     &nkon,ener,xbounold,xforcold,xloadold,&omold,bodyfold,amname,amnameLen,
	     amta,namta,&nam,iamforc,iamload,&iamom,&iambodyf,iamt1,iamboun,
             &ttime,output,outputLen);

      }

      else if(iperturb<2){
	
	prespooles(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,nodempc,coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,&icol,jq,&irow,&neq,&nzl,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
	     alcon,nalcon,alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,&nzs,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,adb,aub,noelplab,noelplabLen,nodeflab,nodeflabLen,eei,&iexpl,plicon,
             nplicon,plkcon,nplkcon,xstate,&npmat_,matname,matnameLen,
	     &isolver,&mint_,&ncmat_,&nstate_,ns,csab,&nkon,ener,
             xbounold,xforcold,xloadold,&omold,bodyfold,amname,amnameLen,amta,namta,
             &nam,iamforc,iamload,&iamom,&iambodyf,iamt1,iamboun,&ttime,
             output,outputLen);

      }

      else{

	mpcinfo[0]=memmpc_;mpcinfo[1]=mpcfree;mpcinfo[2]=icascade;
	mpcinfo[3]=maxlenmpc;

	nonlingeo(co,&nk,kon,ipkon,lakon,lakonLen,&ne,nodeboun,ndirboun,xboun,&nboun, 
	     ipompc,&nodempc,&coefmpc,labmpc,labmpcLen,&nmpc,nodeforc,ndirforc,xforc,
             &nforc, 
	     nelemload,sideload,sideloadLen,xload,&nload,p1,p2,&om,bodyf, 
	     ad,au,b,nactdof,&icol,jq,&irow,&neq,&nzl,&nmethod,ikmpc, 
	     ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
	     alcon,nalcon,alzero,ielmat,ielorien,&norien,orab,&ntmat_,
             t0,t1,t1old,&ithermal,prestr,&iprestr, 
	     vold,&iperturb,sti,&nzs,nodeprint,&noprint,nelemprint,&neprint,
	     &kode,adb,aub,noelplab,noelplabLen,nodeflab,nodeflabLen,&idrct,&jmax,
	     &jout,&tinc,&tper,&tmin,&tmax,eei,xbounold,xforcold,xloadold,
	     &omold,bodyfold,veold,accold,amname,amnameLen,amta,namta,
	     &nam,iamforc,iamload,&iamom,&iambodyf,iamt1,&alpha,&haftol,
             &iexpl,iamboun,plicon,nplicon,plkcon,nplkcon,
	     xstate,&npmat_,&istep,&ttime,matname,matnameLen,&qaold,&mint_,
	     &isolver,&ncmat_,&nstate_,&iumat,ns,csab,&nkon,ener,
	     mpcinfo,nnn,output,outputLen,nodeflow,iamflow,
             xflow,shcon,nshcon,cocon,ncocon,physcon,xflowold,&nflow,ctrl);

	memmpc_=mpcinfo[0];mpcfree=mpcinfo[1];icascade=mpcinfo[2];
        maxlenmpc=mpcinfo[3];


      }
    }
  else if(nmethod==2)
    {  
    }
  else if(nmethod==3)
    {
    }
  else if(nmethod==4)
    {
    }

  free(nactdof);
  free(icol);
  free(jq);
  if(isolver!=1){free(irow);}

  /* deleting the perturbation loads and temperatures */

  if((iperturb == 1)&&(nmethod==3)) {
    nforc=0;
    nload=0;
    om=0.;
    for(k=0;k<3;++k){
      bodyf[k]=0.;
    }
    if(ithermal == 1) {
      for(k=0;k<nk;++k){
	t1[k]=t0[k];
      }
    }
  }

  else{
    nbounold=nboun;
    nforcold=nforc;
    nloadold=nload;
    if(ithermal>1)nflowold=nflow;

    /* resetting the amplitude to none except for time=total time amplitudes */

    if(nam > 0) {
	for (i=0;i<nboun;i++) {
	    if(namta[3*iamboun[i]-1]!=1) iamboun[i]=0;
	}
	for (i=0;i<nforc;i++){
	    if(namta[3*iamforc[i]-1]!=1) iamforc[i]=0;
	}
	for (i=0;i<2*nload;i++){
	    if(namta[3*iamload[i]-1]!=1) iamload[i]=0;
	}
	if(namta[3*iamom-1]!=1) iamom=0;
	if(namta[3*iambodyf-1]!=1) iambodyf=0;
	if(ithermal==1) {
	    if(namta[3*iamt1[i]-1]!=1) iamt1[i]=0;
	}
    }
  }

}

 FORTRAN(frdclose,());

 return 0;
      
}

invivoCalculiX_main_181

Real time: 8.684591e+07 -- Predicted time: 4.969229e+07

Callcount: 1

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
1	### 1	1	4.969229e+07	8.766728e+07	43.3

                !
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
!
!     identifies the position id of px in an ordered array
!     x of integers; 
!
!     id is such that x(id).le.px and x(id+1).gt.px
!
      SUBROUTINE nIDENT(X,PX,N,ID)
      IMPLICIT none
      integer x,px,n,id,n1,n2,m
      DIMENSION X(N)
      if(n.eq.0) then
         id=0
         return
      endif
      N1=0
      N2=N+1
      do
         M=(N2+N1)/2
         IF(PX.GE.X(M)) N1=M
         IF(PX.LT.X(M)) N2=M
         IF((N2-N1).EQ.1) GO TO 2
      enddo
2     ID=N1
      RETURN
      END

invivonident_nident__34

Real time: 4.507584e+06 -- Predicted time: 1.709967e+07

Callcount: 55606

Invocation	Cluster	Part	Invitro (cycles)	Invivo (cycles)	Error (%)
10932	### 1	10529.4210443611	3.620000e+02	6.400000e+01	82.3
39837	### 2	17605.425701544	2.520000e+02	7.200000e+01	71.4
11528	### 3	2443.30151295454	3.280000e+02	8.000000e+01	75.6
40409	### 4	8284.78995064714	3.240000e+02	6.800000e+01	79.0
45601	### 5	1894.32755141974	3.500000e+02	4.400000e+01	87.4
2158	### 6	9199.51235676113	4.060000e+02	1.240000e+02	69.4
31993	### 7	5726.39014620357	1.690000e+02	1.400000e+02	17.1

454-calculix

Exec Time : 1.306602e+08 cycles

Matching : 40.0%

__invivo__SPOOLES_Chv_src_Chv_factor_symmetric1x1_600

Real time: 1.753996e+06 -- Predicted time: 2.873963e+06

Callcount: 720

__invivo__mastruct_mastruct_615

Real time: 4.825128e+06 -- Predicted time: 4.780256e+06

Callcount: 1

__invivo__mastruct_mastruct_331

Real time: 1.939523e+07 -- Predicted time: 1.919306e+07

Callcount: 1

__invivo__SPOOLES_Utilities_src_Utilities_DV_DVdot33_1241

Real time: 3.388256e+06 -- Predicted time: 7.024252e+06

Callcount: 7920

__invivo__mastruct_mastruct_705

Real time: 4.270208e+06 -- Predicted time: 4.277338e+06

Callcount: 1

__invivo__SPOOLES_Utilities_src_Utilities_newsort_IVqsortUp_975

Real time: 1.825840e+06 -- Predicted time: 1.007780e+07

Callcount: 12588

__invivo__isortii_isortii__199

Real time: 1.202479e+07 -- Predicted time: 9.773259e+06

Callcount: 1441

__invivo__results_results__1301

Real time: 4.682592e+06 -- Predicted time: 1.284400e+05

Callcount: 1

__invivo__SPOOLES_Utilities_src_Utilities_sortAndCompress_IV2DVsortUpAndCompress_339

Real time: 3.298192e+06 -- Predicted time: 3.343572e+06

Callcount: 1

__invivo__results_results__1256

Real time: 2.137528e+06 -- Predicted time: 1.115480e+05

Callcount: 1

__invivo__SPOOLES_InpMtx_src_InpMtx_fullAdj_InpMtx_fullAdjacency_106

Real time: 3.439360e+06 -- Predicted time: 3.657180e+06

Callcount: 1

__invivo__SPOOLES_Utilities_src_Utilities_newsort_IVDVqsortUp_1253

Real time: 1.646192e+06 -- Predicted time: 3.200466e+06

Callcount: 4949

__invivo__mafillsm_mafillsm__146

Real time: 1.097620e+07 -- Predicted time: 1.111723e+07

Callcount: 1

__invivo__SPOOLES_FrontMtx_src_FrontMtx_update_FrontMtx_update_37

Real time: 5.072364e+06 -- Predicted time: 7.213491e+05

Callcount: 13

__invivo__SPOOLES_Utilities_src_Utilities_DV_DVaxpy_59

Real time: 2.115172e+06 -- Predicted time: 4.977536e+06

Callcount: 14445

__invivo__CalculiX_main_145

Real time: 2.251224e+06 -- Predicted time: 2.034871e+12

Callcount: 1

__invivo__spooles_spooles_86

Real time: 2.362836e+06 -- Predicted time: 2.193946e+06

Callcount: 1

__invivo__SPOOLES_Utilities_src_Utilities_newsort_IV2DVqsortUp_1402

Real time: 2.569520e+06 -- Predicted time: 2.751744e+06

Callcount: 711

__invivo__SPOOLES_Chv_src_Chv_update_Chv_updateS_687

Real time: 4.991592e+06 -- Predicted time: 5.313286e+06

Callcount: 66

__invivo__e_c3d_e_c3d__247

Real time: 2.858368e+06 -- Predicted time: 3.355124e+06

Callcount: 32

__invivo__CalculiX_main_181

Real time: 8.684591e+07 -- Predicted time: 4.969229e+07

Callcount: 1

__invivo__nident_nident__34

Real time: 4.507584e+06 -- Predicted time: 1.709967e+07

Callcount: 55606

invivoSPOOLES_Chv_src_Chv_factor_symmetric1x1_600

invivomastruct_mastruct_615

invivomastruct_mastruct_331

invivoSPOOLES_Utilities_src_Utilities_DV_DVdot33_1241

invivomastruct_mastruct_705

invivoSPOOLES_Utilities_src_Utilities_newsort_IVqsortUp_975

invivoisortii_isortii__199

invivoresults_results__1301

invivoSPOOLES_Utilities_src_Utilities_sortAndCompress_IV2DVsortUpAndCompress_339

invivoresults_results__1256

invivoSPOOLES_InpMtx_src_InpMtx_fullAdj_InpMtx_fullAdjacency_106

invivoSPOOLES_Utilities_src_Utilities_newsort_IVDVqsortUp_1253

invivomafillsm_mafillsm__146

invivoSPOOLES_FrontMtx_src_FrontMtx_update_FrontMtx_update_37

invivoSPOOLES_Utilities_src_Utilities_DV_DVaxpy_59

invivoCalculiX_main_145

invivospooles_spooles_86

invivoSPOOLES_Utilities_src_Utilities_newsort_IV2DVqsortUp_1402

invivoSPOOLES_Chv_src_Chv_update_Chv_updateS_687

invivoe_c3d_e_c3d__247

invivoCalculiX_main_181

invivonident_nident__34