/*     CalculiX - A 3-dimensional finite element program                   */
/*              Copyright (C) 1998-2005 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 "CalculiX.h"

void profile(double *co, int *nk, int *kon, int *ipkon, char *lakon,
	     int *ne, 
	     int *nodeboun, int *ndirboun, double *xboun, int *nboun, 
	     int *ipompc, int *nodempc, double *coefmpc, char *labmpc,
             int *nmpc, 
	     int *nodeforc, int *ndirforc,double *xforc, int *nforc, 
	     int *nelemload, char *sideload, double *xload,
	     int *nload, 
	     double *ad, double *au, double *b, int *nactdof, 
	     int *jp, int *jq, int *neq, 
	     int *nmethod, int *ikmpc, int *ilmpc, int *ikboun, 
	     int *ilboun,
	     double *elcon, int *nelcon, double *rhcon, int *nrhcon,
	     double *alcon, int *nalcon, double *alzero, int *ielmat,
	     int *ielorien, int *norien, double *orab, int *ntmat_,
	     double *t0, double *t1, double *t1old,int *ithermal,
             double *prestr, int *iprestr, 
	     double *vold,int *iperturb, double *sti,  
	     int *kode, int *nsky, char *filab,
	     double *eme, int *iexpl, 
             double *plicon, int *nplicon, double *plkcon,
             int *nplkcon,
             double *xstate, int *npmat_, char *matname, int *mint_,
             int *ncmat_, int *nstate_, double *cs, int *mcs, int *nkon,
             double *ener, double *xbounold,
	     double *xforcold, double *xloadold,
             char *amname, double *amta, int *namta,
             int *nam, int *iamforc, int *iamload,
             int *iamt1, int *iamboun, double *ttime,char *output, 
             char *set, int *nset, int *istartset,
             int *iendset, int *ialset, int *nprint, char *prlab,
             char *prset, int *nener, double *trab, 
             int *inotr, int *ntrans, double *fmpc, char *cbody,int *ibody,
	     double *xbody, int *nbody, double *xbodyold){
  char description[13]="            ";  
  int k, flg=0, *inum=NULL,iout=1,ielas,icmd,iinc=1,istep=1,mode=-1,noddiam=-1;
  int mass=0, stiffness=1, buckling=0, rhsi=1, intscheme=0,*ncocon=NULL,
    *ipobody=NULL,inewton;
  double *stn=NULL, *stx=NULL, *v=NULL, energy,*xstiff=NULL,
    *een=NULL,vmax,*f=NULL,*fn=NULL,qa,*epn=NULL,*xstateini=NULL,
    *stiini=NULL,*vini=NULL,*enern=NULL,*xbounact=NULL,*xforcact=NULL,
    *xloadact=NULL,*t1act=NULL,*ampli=NULL,*xstaten=NULL,
    *eei=NULL,*enerini=NULL,*cocon=NULL,
    *qfx=NULL,*qfn=NULL,*cgr=NULL,*xbodyact=NULL;

  /* dummy arguments for the results call */

  double *veold=NULL,*accold=NULL,bet,gam,dtime,time=1.,reltime=1.;

  int *ipneigh=NULL,*neigh=NULL;

  /* PROFILE METHOD */

  /* allocating fields for the actual external loading */

  xbounact=NNEW(double,*nboun);
  for(k=0;k<*nboun;++k){xbounact[k]=xbounold[k];}
  xforcact=NNEW(double,*nforc);
  xloadact=NNEW(double,2**nload);
  xbodyact=NNEW(double,7**nbody);
  /* copying the rotation axis and/or acceleration vector */
  for(k=0;k<7**nbody;k++){xbodyact[k]=xbody[k];}
  if(*ithermal==1){
    t1act=NNEW(double,*nk);
    for(k=0;k<*nk;++k){t1act[k]=t1old[k];}
  }
  
  /* assigning the body forces to the elements */ 

  ipobody=NNEW(int,3**ne);
  FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
		    iendset,ialset,&inewton,nset));

  /* allocating a field for the instantaneous amplitude */

  ampli=NNEW(double,*nam);

  FORTRAN(tempload,(xforcold,xforc,xforcact,iamforc,nforc,xloadold,xload,
	      xloadact,iamload,nload,ibody,xbody,nbody,xbodyold,xbodyact,
	      t1old,t1,t1act,iamt1,nk,amta,
	      namta,nam,ampli,&time,&reltime,ttime,&dtime,ithermal,nmethod,
              xbounold,xboun,xbounact,iamboun,nboun,
	      nodeboun,ndirboun,nodeforc,ndirforc,&istep,&iinc,
              co,vold));
  *ttime=*ttime+1.;
  
  /* filling in the matrix */
  
  ad=NNEW(double,*neq);
  au=NNEW(double,*nsky);
  b=NNEW(double,*neq);
  
  FORTRAN(mafillpr,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xbounact,nboun,
	    ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,nforc,
	    nelemload,sideload,xloadact,nload,xbodyact,
            ipobody,nbody,cgr,ad,au,b,
	    nactdof,jp,jq,neq,nmethod,ikmpc,ilmpc,ikboun,ilboun,
	    elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
	    ielorien,norien,orab,ntmat_,t0,t1act,
	    ithermal,prestr,iprestr,vold,iperturb,stx,sti,iexpl,
            plicon,nplicon,plkcon,nplkcon,
	    xstiff,npmat_,&dtime,matname,mint_,ncmat_,&mass,&stiffness,
            &buckling,&rhsi,&intscheme));
  
  if(*nmethod==1)
    {
      
      /* triangulation of the system matrix */
      
      
      printf("LU-decomposition of the system of equations (profiler)\n\n");
      
      if(*neq>0) FORTRAN(datri,(au,au,ad,jp,neq,&flg));
      
      /* solving the system */
      
      printf("solving the system of equations\n\n");
      
      if(*neq>0) FORTRAN(dasol,(au,au,ad,b,jp,neq,&energy));

      free(au);
      free(ad);
      
      /* calculating the displacements and stresses */
      
      v=NNEW(double,4**nk);
      fn=NNEW(double,4**nk);
      
      stn=NNEW(double,6**nk);
      inum=NNEW(int,*nk);
      stx=NNEW(double,6**mint_**ne);
  
      if(strcmp1(&filab[18],"E   ")==0) een=NNEW(double,6**nk);
      if(strcmp1(&filab[36],"ENER")==0) enern=NNEW(double,*nk);

      eei=NNEW(double,6**mint_**ne);
      if(*nener==1){
	  stiini=NNEW(double,6**mint_**ne);
	  enerini=NNEW(double,*mint_**ne);}

      FORTRAN(results,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
	      stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
	      alzero,ielmat,ielorien,norien,orab,ntmat_,
	      t0,t1,ithermal,prestr,iprestr,filab,eme,een,iperturb,f,fn,
              nactdof,&iout,&qa,vold,b,nodeboun,ndirboun,
	      xboun,nboun,ipompc,
	      nodempc,coefmpc,labmpc,nmpc,nmethod,&vmax,neq,veold,accold,
              &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
	      xstateini,xstiff,xstate,npmat_,epn,matname,mint_,&ielas,
              &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
              sti,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
              iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
              fmpc,nelemload,nload));
      
      free(b);free(eei);
      if(*nener==1){
	  free(stiini);free(enerini);}
      
      for(k=0;k<4**nk;++k){
	vold[k]=v[k];
      }
      for(k=0;k<6**mint_**ne;++k){
	sti[k]=stx[k];
      }
      
      ++*kode;

      if(*mcs>0){
	frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,
               t1,
	       fn,ttime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
               nstate_,&istep,&iinc,iperturb,ener,mint_,output,ithermal,
               qfn,ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
	       norien,sti);
      }
      else{
    ipneigh=NNEW(int,*nk);neigh=NNEW(int,40**ne);
	FORTRAN(out,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,t1,
		     fn,ttime,epn,ielmat,matname,enern,xstaten,nstate_,&istep,&iinc,
		     iperturb,ener,mint_,output,ithermal,qfn,&mode,&noddiam,
                     trab,inotr,ntrans,orab,ielorien,norien,description,
                     ipneigh,neigh,sti));free(ipneigh);free(neigh);
      }
      
      free(v);free(fn);free(stn);free(inum);free(stx);

      if(strcmp1(&filab[18],"E   ")==0) free(een);
      if(strcmp1(&filab[36],"ENER")==0) free(enern);

    }
  
  else
    {
      
      /* error occurred in mafill: storing the geometry in frd format */
      
      ++*kode;
    ipneigh=NNEW(int,*nk);neigh=NNEW(int,40**ne);
      FORTRAN(out,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,t1,
           fn,ttime,epn,ielmat,matname,enern,xstaten,nstate_,&istep,&iinc,
		     iperturb,ener,mint_,output,ithermal,qfn,&mode,&noddiam,
                     trab,inotr,ntrans,orab,ielorien,norien,description,
                     ipneigh,neigh,sti));free(ipneigh);free(neigh);
    }

  /* updating the loading at the end of the step; 
     important in case the amplitude at the end of the step
     is not equal to one */

  for(k=0;k<*nboun;++k){xbounold[k]=xbounact[k];}
  for(k=0;k<*nforc;++k){xforcold[k]=xforcact[k];}
  for(k=0;k<2**nload;++k){xloadold[k]=xloadact[k];}
  for(k=0;k<7**nbody;k=k+7){xbodyold[k]=xbodyact[k];}
  if(*ithermal==1){
    for(k=0;k<*nk;++k){t1old[k]=t1act[k];}
  }

  free(xbounact);free(xforcact);free(xloadact);free(t1act);free(ampli);
  free(xbodyact);free(ipobody);
  
  return;
}
